求助：VBA按名称匹配将Sheet2指定列值替换到Sheet1对应列

原有代码存在的核心错误 #

• 变量声明与赋值不匹配：代码声明了ws1/ws2工作表变量，实际赋值时使用了未声明的sh1/sh2，开启强制变量声明选项时会直接报错
• 单元格对象赋值时机错误：待写入的Z列单元格options_other、待读取的J列单元格info_other在循环外提前赋值，此时遍历用的名称单元格对象还未指向具体数据行，对象为空
• 单元格引用缺失父对象指定：Cells()方法未明确绑定所属工作表，默认读取当前活动工作表的单元格，跨表操作时极易取错位置
• 动态范围取法有缺陷：使用xlDown向下定位范围边界时，只要列中存在空单元格就会提前截断范围，漏读后续数据
• 存在冗余无效代码：定义的r3/r4范围全程未参与逻辑运算，无实际作用

修正后可直接运行的代码 #

Sub H_Replace_Other()
    Dim wsOpt As Worksheet, wsBld As Worksheet
    Dim rngOptName As Range, rngBldName As Range
    Dim cellOpt As Range, cellBld As Range
    
    ' 绑定目标工作表
    Set wsOpt = ThisWorkbook.Worksheets("options")
    Set wsBld = ThisWorkbook.Worksheets("building info")
    
    ' 动态取两表名称列有效数据范围（从第3行开始到列内最后一个非空行）
    Set rngOptName = wsOpt.Range("G3:G" & wsOpt.Cells(wsOpt.Rows.Count, "G").End(xlUp).Row)
    Set rngBldName = wsBld.Range("D3:D" & wsBld.Cells(wsBld.Rows.Count, "D").End(xlUp).Row)
    
    ' 逐行校验options表G列名称
    For Each cellOpt In rngOptName
        ' 跳过空单元格避免无效匹配
        If cellOpt.Value <> "" Then
            For Each cellBld In rngBldName
                ' 统一转字符串比较，规避格式不一致导致的匹配失败
                If CStr(cellOpt.Value) = CStr(cellBld.Value) Then
                    ' 将building info表对应行J列值写入options表当前行Z列
                    wsOpt.Cells(cellOpt.Row, "Z").Value = wsBld.Cells(cellBld.Row, "J").Value
                    Exit For ' 匹配成功后跳出内循环，减少不必要遍历
                End If
            Next cellBld
        End If
    Next cellOpt
End Sub

逻辑说明 #

• 采用xlUp方式从列底部向上定位最后一个非空单元格，彻底解决中间有空单元格时范围截断的问题
• 所有单元格操作均明确指定所属工作表，不受当前活动工作表切换影响，运行结果稳定
• 匹配时统一转为字符串格式比较，避免文本型数字、数值型数字格式差异导致的匹配遗漏
• 增加空单元格跳过逻辑，减少无意义的循环判断

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