我有一个包含大约 50 个单元格(包含公式)的工作表,这些单元格根据外部工作簿中的单元格而变化。
当这些单元格中的任何一个更改其值时,我想触发某个宏。
Worksheet_change 事件不起作用并且 Worksheet_Calculate 不引用更改的目标单元格。
我找到了这段代码,但它无济于事,因为它会测试是否只更改了一个单元格值(“A1”)。
Private Sub Worksheet_Calculate()
Static OldVal As Variant
If Range("A1").Value <> OldVal Then
OldVal = Range("A1").Value
Call Macro
End If
End Sub
因此,我非常感谢您帮助寻找此问题的解决方案。
注意:所有包含公式的单元格都是命名单元格。
您可以将工作表的值保留在内存中,并在每次重新计算时检查已更改的值,同时更新该数组。
这是一些代码,放置在ThisWorkbook
模块中,将为第一张纸设置这样的检测(更改Sheet1
为您要监视的任何一张纸):
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)
' This is the place where you would put your logic
Debug.Print cell.Address & " changed from '" & oldValue & "' to '" & cell.Value & "'"
End Sub
您可以If
在最后一个例程中使用一些语句来仅过滤掉您真正感兴趣的那些范围。
如果您需要监视多个工作表中的更改,您可以将缓存构建为一组 2D 数组,每个工作表一个集合条目,以其名称为键。
Dim cache As Collection
Private Sub Workbook_Open()
Dim sheet As Worksheet
Set cache = New Collection
' Initialise the cache when the workbook opens
For Each sheet In ActiveWorkbook.Sheets
cache.Add getSheetValues(sheet), sheet.CodeName
Next
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
' Get the values of the sheet and from the cache
previous = cache(Sh.CodeName)
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.Remove Sh.CodeName
cache.Add current, Sh.CodeName
ext:
End Sub
Private Sub CellChanged(cell As Range, oldValue As Variant)
' This is the place where you would put your logic
Debug.Print cell.Address & " changed from '" & oldValue & "' to '" & cell.Value & "'"
End Sub
这适用于从一开始就存在的工作表,而不是添加的工作表。当然,这也可以实现,但你会明白的。
本文收集自互联网,转载请注明来源。
如有侵权,请联系[email protected] 删除。
我来说两句