Excel VBA实现A列匹配E列后用对应B列值替换E列原值的方法

原有代码问题 #

• 变量赋值顺序错误：Lastrow 在被用于定义E列范围后才赋值，初始为默认值0，导致E列遍历范围完全错误
• 匹配逻辑错误：仅对比了同一行的A、E列值，未实现A列单值遍历全E列的需求
• 单元格引用未绑定工作表对象，若运行时当前工作表不是Sheet1会出现取值错误

修正后代码 #

Sub CopyCells1()
    Dim i As Long
    Dim lastRowA As Long, lastRowE As Long
    Dim ws As Worksheet
    Dim findRng As Range
    
    ' 绑定工作表对象
    Set ws = Workbooks("Control.xlsm").Worksheets("Sheet1")
    
    ' 分别获取A列、E列的最后有效行
    lastRowA = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    lastRowE = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
    
    ' 遍历A列所有有效行
    For i = 1 To lastRowA
        ' 在E列全范围查找A列当前值的匹配项
        Set findRng = ws.Range("E1:E" & lastRowE).Find(What:=ws.Cells(i, "A").Value, LookIn:=xlValues, LookAt:=xlWhole)
        ' 找到匹配项则替换为对应B列值
        If Not findRng Is Nothing Then
            findRng.Value = ws.Cells(i, "B").Value
            Set findRng = Nothing ' 重置查找对象
        End If
    Next
End Sub

代码说明 #

• 提前获取A、E两列的有效行数，避免范围取值错误
• 使用Find方法遍历E列全范围查找匹配值，效率高于两层循环遍历
• 所有单元格操作绑定工作表对象，避免跨表运行错误
• 匹配规则默认是单元格完全匹配，如果需要模糊匹配可以修改LookAt:=xlPart
• 上述代码默认只替换E列第一个匹配项，若需要替换E列所有匹配的单元格，可扩展添加FindNext循环逻辑

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