如何使用VBA用Sheet1对应新ID批量替换Sheet2的ID列值

原代码问题定位 #

• 直接复用Sheet1的行数作为Sheet2的遍历范围边界，当Sheet2数据量大于Sheet1时，超出范围的行不会被替换
• 未对数组变量做合法性校验，当Sheet1仅存在表头无有效数据时，读取数组会触发下标越界错误
• 逐行调用Replace方法效率极低，仅适配极小数据量场景，数据量过大会出现卡顿

修复后代码（适配任意数据量） #

Sub BatchReplaceID()
    Dim dict As Object
    Dim lastRow1 As Long, lastRow2 As Long, i As Long
    Dim arrSheet1, arrSheet2
    
    ' 创建字典存储ID和New ID的映射关系
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 读取Sheet1的ID映射对，不需要选中工作表，避免操作误差
    With Sheets("Sheet1")
        lastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
        ' 校验Sheet1是否有有效数据
        If lastRow1 < 2 Then
            MsgBox "Sheet1无有效映射数据，退出运行"
            Exit Sub
        End If
        arrSheet1 = .Range("A2:B" & lastRow1).Value
        ' 批量写入字典，仅遍历Sheet1一次
        For i = 1 To UBound(arrSheet1)
            ' 跳过ID为空的行，避免误替换
            If arrSheet1(i, 1) <> "" Then
                dict(arrSheet1(i, 1)) = arrSheet1(i, 2)
            End If
        Next i
    End With
    
    ' 处理Sheet2的ID替换
    With Sheets("Sheet2")
        lastRow2 = .Cells(.Rows.Count, "A").End(xlUp).Row
        ' 校验Sheet2是否有有效数据
        If lastRow2 < 2 Then
            MsgBox "Sheet2无待替换数据，退出运行"
            Exit Sub
        End If
        arrSheet2 = .Range("A2:A" & lastRow2).Value
        ' 遍历数组做替换，比直接操作单元格效率高数十倍
        For i = 1 To UBound(arrSheet2)
            If dict.exists(arrSheet2(i, 1)) Then
                arrSheet2(i, 1) = dict(arrSheet2(i, 1))
            End If
        Next i
        ' 批量写回Sheet2，仅操作单元格一次
        .Range("A2:A" & lastRow2).Value = arrSheet2
    End With
    
    ' 释放对象内存
    Set dict = Nothing
    MsgBox "替换完成，共处理" & lastRow2 - 1 & "条数据"
End Sub

适配说明 #

• 采用字典预存映射关系，仅对两个工作表各做一次读写操作，支持10万级以上数据量无卡顿
• 分别计算两个工作表的有效数据行数，不会出现范围不匹配问题
• 增加了空数据校验，避免下标越界报错

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