Отслеживать изменения ячеек в комментариях в именованных диапазонах - PullRequest
0 голосов
/ 18 февраля 2020

У меня есть код, который проверяет, была ли изменена какая-либо ячейка в Sheet1. Все ячейки являются формулами, поэтому я использую Worksheet_Calculate. Если он изменен, он гарантирует, что пользователь захочет записать старое значение в качестве комментария.

Dim cache As Variant

Private Sub Workbook_Open()
    cache = getSheetValues(Sheet1)
End Sub

Private Function getSheetValues(sheet As Worksheet) As Variant
    Dim arr As Variant
    Dim cell As Range

'    Get last cell in the used range
    Set cell = sheet.Cells.SpecialCells(xlCellTypeLastCell)
    ' Get all values in the range between A1 and that cell
    arr = sheet.Cells.Resize(cell.Row, cell.Column)
    If IsEmpty(arr) Then ReDim arr(0, 0) ' Default if no data at all
    getSheetValues = arr


End Function

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Dim current As Variant
    Dim previous As Variant
    Dim i As Long
    Dim j As Long
    Dim prevVal As Variant
    Dim currVal As Variant

    If Sh.CodeName <> Sheet1.CodeName Then Exit Sub
    ' Get the values of the sheet and from the cache
    previous = cache
    current = getSheetValues(Sh)
    For i = 1 To WorksheetFunction.Max(UBound(previous), UBound(current))
        For j = 1 To WorksheetFunction.Max(UBound(previous, 2), UBound(current, 2))
            prevVal = ""
            currVal = ""
            On Error Resume Next ' Ignore errors when out of array bounds
                prevVal = previous(i, j)
                currVal = current(i, j)
            On Error GoTo 0
            If prevVal <> currVal Then
                ' Change detected: call the function that will treat this
                CellChanged Sheet1.Cells(i, j), prevVal
            End If
        Next
    Next
    ' Update cache
    cache = current
ext:
End Sub

Private Sub CellChanged(cell As Range, oldValue As Variant)

Dim answer As Integer
    ' This is the place where you would put your logic

    Sheet1.Activate

    answer = MsgBox("Changement de casier!" & Chr(10) & "Garder l'historique de " & Chr(10) & """" & oldValue & """?", _
    vbQuestion + vbYesNo, "Attention")


    If answer = vbYes Then


    cell.ClearComments
    cell.AddComment.Text Text:=oldValue & Chr(10) & Format(Date, "dd-mm-yyyy")

    Else: Exit Sub

    End If

End Sub

Это отлично работает. Однако я не хочу, чтобы он просматривал весь лист. Я хочу, чтобы он смотрел на 3 именованных диапазона. Попытка изменения getSheetValues = Range("Colonne8300"), но это не работает.

1 Ответ

0 голосов
/ 18 февраля 2020

getSheetValues ожидает объект листа, если вы хотите отправить ему диапазон (т. Е. Использовать getSheetValues = Range("Colonne8300")), вам нужно изменить функцию, чтобы принять диапазон:

Private Function getSheetValues(myRange As Range) As Variant

Затем измените функция для использования myRange вместо всех ячеек на листе.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...