Excel VBA中如何在同一循环内遍历两个Range对象？

核心问题拆解 #

1. 多单元格旧值保存失效：原代码循环索引从0开始（Excel单元格索引从1起），导致第一个单元格引用错误；变量名ErsteFreieZeile未定义（应为FirstFreeRow）；OldValue作为Range直接按索引引用时，无法和Target的单元格一一对应，尤其非连续选区场景。
2. 遍历双Range对象的误区：For Each完全可以实现双Range的对应遍历，只需确保两个Range的单元格顺序一致，或通过单元格位置匹配。

修改后的完整代码 #

Dim OldValue As Variant ' 改用变量组存储旧值，避免Range引用失效

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim FirstFreeRow As Long
    Dim tCell As Range
    Dim cellIndex As Integer
    
    ' 排除无关工作表和非目标区域
    If Sh.Name = "Changes" Or Sh.Name = "Tabelle2" Then Exit Sub
    If Intersect(Target, Sh.Range("A2:Z550")) Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    
    ' 先获取Changes表的首个空行，避免循环内重复计算
    FirstFreeRow = Sheets("Changes").Cells(Rows.Count, 1).End(xlUp).Row + 1
    
    ' 遍历Target每个单元格，同时匹配OldValue中的对应值
    cellIndex = 1
    For Each tCell In Target
        With Sheets("Changes").Rows(FirstFreeRow)
            .Cells(1) = tCell.EntireColumn.Cells(1).Value
            .Cells(2) = tCell.EntireRow.Cells(2).Value
            .Cells(3) = tCell.EntireRow.Cells(3).Value
            ' 从OldValue数组中取对应位置的旧值
            If cellIndex <= UBound(OldValue) Then
                .Cells(4) = OldValue(cellIndex)
            End If
            .Cells(5) = tCell.Value
            .Cells(6) = Environ("username")
        End With
        FirstFreeRow = FirstFreeRow + 1 ' 下移一行，准备下一条记录
        cellIndex = cellIndex + 1
    Next tCell
    
    Application.EnableEvents = True
End Sub

Public Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    ' 将选中单元格的值存储为一维数组，确保顺序对应
    If Not Intersect(Target, Sh.Range("A2:Z550")) Is Nothing Then
        OldValue = Target.Value
        ' 处理单个单元格时的数组维度问题
        If Target.Count = 1 Then OldValue = Array(OldValue)
    End If
End Sub

关键修改说明 #

1. 旧值存储方式优化：把OldValue改为Variant类型，存储选中单元格的值数组，避免Range引用在单元格修改后失效，同时保证多单元格值的顺序对应。
2. 循环逻辑修正：用For Each遍历Target的每个单元格，通过cellIndex匹配OldValue数组中的对应值；循环外预先计算首个空行，提升效率。
3. 变量名与索引修复：修正德语变量名ErsteFreieZeile为FirstFreeRow；单元格索引从1开始，避免越界错误。

剪切粘贴旧值获取的解决方案 #

剪切粘贴操作会触发SheetSelectionChange到新单元格，导致原选中区域的旧值被覆盖，可通过以下方式处理：

1. 临时缓存旧值：在Workbook_SheetChange事件触发前，利用Application.Undo先撤销修改，获取旧值后再恢复修改。示例代码片段：

' 在Workbook_SheetChange开头添加
Dim tempValue As Variant
Application.Undo
tempValue = Target.Value ' 获取旧值
Application.Undo ' 恢复修改

' 后续用tempValue代替OldValue即可

注意：此方法仅适用于单次剪切粘贴，批量操作需额外判断。

内容的提问来源于stack exchange，提问作者Daniel