Excel Worksheet.Change 事件未捕获所有更改

Question

执行以下操作时：right click-> Delete...->Shift cells up|left在选定的单元格上。Target传递到的范围仅Worksheet.Change反映选择，而不反映向上或向左移动的单元格。

问题说明（抱歉，我无法从这台计算机上传图像）：

假设我的工作表中有以下单元格：

#	A	乙	C	D
1	1	1	1	1
2	2	2	2	2
3	3	3	3	3

如果我要选择范围B1:C1并执行以下操作：right click-> Delete...->Shift cells up

工作表现在看起来像这样：

#	A	乙	C	D
1	1	2	2	1
2	2	3	3	2
3	3			3

根据Worksheet.Change事件：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Debug.Print Target.Address
End Sub

已更改的单元格是$B$1:$C$1（原始选择）。

然而，很明显单元格$B$1:$C$3已经改变（从技术上讲，B 列和 C 列中的所有单元格可能都已经改变，但我对此不感兴趣）。

是否有一种干净有效的方法来检测已发生变化的最小范围的细胞？

我已经做了几次尝试，比如跟踪选择更改时的使用范围，并将以前使用的范围与当前使用范围的“凸包”进行比较，并且Target. 但它们要么非常慢，要么不能处理一些边缘情况。

Answer 1

The Worksheet.Change event is very specific about what triggers it: it fires whenever a cell's formula/value is changed. When you delete cells and shift up, the cells underneath don't change, but their Address does - provable with a few lines in the immediate toolwindow:

set x = [A2]
[A1].delete xlshiftup
?x.address
$A$1

Since nothing in the Excel object model is tracking address changes, you're on your own here.

The challenge here is that Range("B1") will always return a brand new object pointer, so you can't use the Is operator to compare object references; Range("B1") Is Range("B1") will always be False:

?objptr([B1]),objptr([B1]),objptr([B1])
 2251121322704               2251121308592               2251121315312 
 2251121313296               2251121308592               2251121310608 
 2251121315312               2251121322704               2251121308592 

The pointer addresses do recur, but they're not reliable and there's no guarantee that another cell won't take that spot on another call - in fact it seems likely, since I got a collision on the first attempt:

?objptr([B2])
 2251121322704 

So we need a little data structure to help us out here - let's add a new TrackedCell class module where we can store the address independently from the Range reference, on the same object.

The catch is that we're deleting cells, so the encapsulated Range reference will throw error 424 "object required" if we try to access it - but that's useful information we can put to good use:

Private mOriginalAddress As String
Private mCell As Range

Public Property Get CurrentAddress() As String
    On Error Resume Next
    CurrentAddress = mCell.Address()
    If Err.Number <> 0 Then
        Debug.Print "Cell " & mOriginalAddress & " object reference is no longer valid"
        Set mCell = Nothing '<~ that pointer is useless now, but IsNothing is useful information
    End If
    On Error GoTo 0
End Property

Public Property Get HasMoved() As Boolean
    HasMoved = CurrentAddress <> mOriginalAddress And Not mCell Is Nothing
End Property

Public Property Get Cell() As Range
    Set Cell = mCell
End Property

Public Property Set Cell(ByVal RHS As Range)
    Set mCell = RHS
    mOriginalAddress = mCell.Address
End Property

Public Property Get OriginalAddress() As String
    OriginalAddress = mOriginalAddress
End Property

Back in the Worksheet module, we need a way to grab these cell references now. Worksheet.Activate could work, but Worksheet.SelectionChange should be tighter:

Option Explicit
Private Const TrackedRange As String = "B1:C42" '<~ specify the tracked range here
Private TrackedCells As New VBA.Collection '<~ As New will never be Nothing

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    Set TrackedCells = New VBA.Collection '<~ wipe whatever we already got
    
    Dim Cell As Range
    For Each Cell In Me.Range(TrackedRange)
        
        Dim TrackedCell As TrackedCell
        Set TrackedCell = New TrackedCell
        
        Set TrackedCell.Cell = Cell
        TrackedCells.Add TrackedCell
    
    Next
    
End Sub

So now we know where the tracked cells are, we're ready to handle Worksheet.Change:

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Debug.Print "Range " & Target.Address & " was modified"
    
    Dim TrackedCell As TrackedCell
    For Each TrackedCell In TrackedCells
        
        If TrackedCell.HasMoved Then
            Debug.Print "Cell " & TrackedCell.OriginalAddress & " has moved to " & TrackedCell.CurrentAddress
        End If
    
    Next

End Sub

To test this you need to pick any cell on the sheet first (to run the SelectionChange handler), and then you can try deleting a cell in the immediate toolwindow:

Private mOriginalAddress As String
Private mCell As Range

Public Property Get CurrentAddress() As String
    On Error Resume Next
    CurrentAddress = mCell.Address()
    If Err.Number <> 0 Then
        Debug.Print "Cell " & mOriginalAddress & " object reference is no longer valid"
        Set mCell = Nothing '<~ that pointer is useless now, but IsNothing is useful information
    End If
    On Error GoTo 0
End Property

Public Property Get HasMoved() As Boolean
    HasMoved = CurrentAddress <> mOriginalAddress And Not mCell Is Nothing
End Property

Public Property Get Cell() As Range
    Set Cell = mCell
End Property

Public Property Set Cell(ByVal RHS As Range)
    Set mCell = RHS
    mOriginalAddress = mCell.Address
End Property

Public Property Get OriginalAddress() As String
    OriginalAddress = mOriginalAddress
End Property

Seems to work pretty nicely here, with a limited number of cells. I wouldn't run this across an entire worksheet (or its UsedRange), but it gives an idea of how to go about it.