跟踪命名范围内注释中的单元格变化

Question

我有一个代码可以查看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")，但无效。

Answer 1

[getSheetValues需要一个工作表对象，如果要向其发送一个范围（即使用getSheetValues = Range("Colonne8300")），则需要更改该函数以接受范围：

Private Function getSheetValues(myRange As Range) As Variant

然后将函数修改为使用myRange，而不是工作表中的所有单元格。