如何编写VBA代码实现Sheet2与Sheet1数据匹配后自动复制内容？

实现逻辑 #

当Sheet2的A2单元格内容发生变化时，自动在Sheet1的A1:A30区域查找匹配的数字，找到对应行后，将Sheet2 B2的内容写入该行的B列。

完整代码 #

打开Excel按Alt + F11进入VBA编辑器，找到左侧工程窗口里的Sheet2，双击打开其代码窗口，粘贴以下代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 只响应A2单元格的内容变化
    If Not Intersect(Target, Me.Range("A2")) Is Nothing Then
        Dim findRange As Range
        Dim searchValue As Variant
        
        ' 获取Sheet2 A2的输入值
        searchValue = Me.Range("A2").Value
        ' 若输入为空，直接退出程序
        If IsEmpty(searchValue) Then Exit Sub
        
        ' 在Sheet1的A1:A30区域精准查找匹配值
        Set findRange = ThisWorkbook.Sheets("Sheet1").Range("A1:A30").Find( _
            What:=searchValue, _
            LookIn:=xlValues, _
            LookAt:=xlWhole, _
            MatchCase:=False)
        
        ' 找到匹配项则写入B列内容，未找到可弹出提示
        If Not findRange Is Nothing Then
            findRange.Offset(0, 1).Value = Me.Range("B2").Value
        Else
            MsgBox "Sheet1的A1:A30区域未找到匹配数字"
        End If
    End If
End Sub

关键代码拆解 #

• Worksheet_Change：工作表的单元格变化事件，仅当Sheet2内单元格内容被修改时触发。
• Intersect(Target, Me.Range("A2"))：判断修改的单元格是否为A2，避免无关操作触发代码。
• Range.Find：VBA内置查找方法，LookAt:=xlWhole确保完全匹配（输入130不会匹配1130），MatchCase:=False忽略大小写（对数字无影响，文本场景适用）。
• findRange.Offset(0,1)：找到匹配的A列单元格后，横向偏移1列定位到同一行的B列。

测试步骤 #

1. 在Sheet2的A2输入Sheet1 A1:A30中存在的数字，比如示例中的130
2. 查看Sheet1对应行的B列，会自动填入Sheet2 B2的内容
3. 若输入数字不存在，会弹出提示（不需要提示可注释掉MsgBox行）

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