求助：修改VBA代码实现仅复制同行相邻单元格值

我懂你的需求啦！你希望修改现有的VBA代码，确保只有当Sheet3与Sheet2的B列内容匹配时，仅复制匹配行的相邻单元格——也就是把Sheet3对应行的A列内容粘贴到Sheet2匹配行的A列，Sheet3对应行的C列内容粘贴到Sheet2匹配行的D列，不管有没有重复匹配，绝对不操作其他行的内容。

先给你调整后的完整代码，关键逻辑都加了注释：

Sub CopyMatchingRowCells()
    Dim ws2 As Worksheet, ws3 As Worksheet
    Dim matchCell As Range
    Dim lastRow3 As Long
    Dim i As Long
    
    ' 绑定工作表（用表名替代序号更稳妥，避免表顺序变动出问题）
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    Set ws3 = ThisWorkbook.Sheets("Sheet3")
    
    ' 获取Sheet3中B列的最后一行，只遍历有数据的行
    lastRow3 = ws3.Cells(ws3.Rows.Count, "B").End(xlUp).Row
    
    ' 遍历Sheet3的每一行（如果有表头，把起始行改成2即可）
    For i = 1 To lastRow3
        ' 跳过Sheet3中B列为空的行
        If ws3.Cells(i, "B").Value <> "" Then
            ' 在Sheet2的B列精准查找当前行的B列内容
            Set matchCell = ws2.Range("B:B").Find(What:=ws3.Cells(i, "B").Value, _
                LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
            
            ' 找到匹配项后，仅操作对应行的相邻单元格
            If Not matchCell Is Nothing Then
                ' 复制Sheet3当前行A列到Sheet2匹配行A列
                ws2.Cells(matchCell.Row, "A").Value = ws3.Cells(i, "A").Value
                ' 复制Sheet3当前行C列到Sheet2匹配行D列
                ws2.Cells(matchCell.Row, "D").Value = ws3.Cells(i, "C").Value
            End If
        End If
    Next i
    
    ' 释放对象，避免内存占用
    Set matchCell = Nothing
    Set ws2 = Nothing
    Set ws3 = Nothing
    
    MsgBox "匹配行内容复制完成！", vbInformation
End Sub

核心逻辑说明： #

• 精准锁定匹配行：用Range.Find直接定位Sheet2中B列的匹配单元格，通过matchCell.Row获取匹配行号，确保只操作这一行，完全不会涉及其他行。
• 无效遍历过滤：先获取Sheet3的有效数据行范围，同时跳过B列为空的行，提升代码运行效率。
• 严格跨行限制：所有赋值操作都绑定在Sheet3的当前行和Sheet2的匹配行，不管InStr返回是否有重复匹配，都不会修改其他行的内容。

如果你的表格有表头（比如第1行是标题），只需要把For i = 1 To lastRow3改成For i = 2 To lastRow3就可以啦！

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