VBA工作表变更事件执行时为何跳过C列？

问题根源 #

你遇到的C列被跳过的问题，本质是正向遍历单元格时执行删除操作导致的集合错位。当你删除B列单元格后，右侧的C列单元格会左移填补B列的空位，但For Each循环是基于初始的cRange单元格集合进行遍历的，下一次迭代会直接跳到集合中的下一个元素（即原D列单元格），刚移过来的C列单元格被完全跳过。

解决方法 #

改用反向遍历（从右到左处理B:O列的单元格），这样删除操作不会影响还未处理的单元格（因为右侧单元格删除后，左侧待处理的单元格位置不会发生变化）。

修改后的完整代码 #

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.CountLarge > 1 Then Exit Sub
 
    Dim dlr As Long
    Dim r As Long
    Dim nr As Long
    Dim lr As Long
    Dim mAValue As Variant
    Dim mARange As Range
    Dim wsIW As Worksheet
    Set wsIW = Worksheets("IW Phase")
 
    If Target.Column = 14 And Target.Row > 12 Then ' 14 means Column N, modify it as per your need
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        r = Target.Row
        lr = 499
        nr = 500
        dlr = wsIW.Cells(Rows.Count, "AB").End(xlUp).Row + 1
       
        Dim Ans As VbMsgBoxResult
        Dim cRange As Range
        Set cRange = wsIW.Range("B" & r & ":O" & r)
 
        If Target.Value = "Review complete, actions closed" Then
            Ans = MsgBox("Action will be moved to the Closed Actions area." & VBA.Constants.vbNewLine & VBA.Constants.vbNewLine & "                        Are you sure?", vbYesNo + vbQuestion + vbDefaultButton2, "Confirm Action Close")
            If Ans = vbYes Then
                wsIW.Cells(dlr, 42).Value = Date
                ' 替换正向For Each为反向遍历（从右到左）
                Dim col As Integer
                For col = cRange.Columns.Count To 1 Step -1
                    Set cell = cRange.Cells(1, col)
                    If cell.MergeCells Then
                        mAValue = cell.MergeArea.Value
                        Set mARange = cell.MergeArea
                        wsIW.Cells(dlr, cell.Column).Offset(0, 26).Value = mAValue
                        mARange.UnMerge
                        cell.Delete xlShiftUp
                        Set mARange = mARange.Resize(mARange.Rows.Count)
                        mARange.Merge
                        mARange.Cells(1, 1).Value = mAValue
                    Else:
                        wsIW.Cells(dlr, cell.Column).Offset(0, 26).Value = cell.Value
                        cell.Delete xlShiftUp
                    End If
                Next col
            Else
                Target.Value = ""
                Application.EnableEvents = True
                Exit Sub
            End If
        End If
 
        Application.ScreenUpdating = True ' Re-enable screen updating
        wsIW.Range("B" & lr & ":O" & lr).Copy wsIW.Range("B" & nr & ":O" & nr)
 
    End If
 
    Application.EnableEvents = True ' Always re-enable events
End Sub

额外说明 #

• 反向遍历避免了单元格移位导致的遍历错位问题，确保每一列都会被处理到。
• 原代码中合并单元格的处理逻辑保持不变，仅修改了遍历方式。

内容的提问来源于stack exchange，提问作者VB eh....