需求：编写VBA宏实现Excel工作簿间数据匹配填充（替代VLOOKUP）

基础版本（两个工作簿已打开） #

这个脚本逻辑和你用的VLOOKUP公式完全一致，直接在VBA中调用工作表函数完成匹配填充：

Sub FillRequirement()
    Dim sourceWS As Worksheet
    Dim targetWS As Worksheet
    Dim lastRow As Long
    Dim i As Long
    
    ' 替换成你的实际工作簿和工作表名称
    Set sourceWS = Workbooks("Workbook1.xlsx").Worksheets("Sheet1")
    Set targetWS = Workbooks("Workbook2.xlsx").Worksheets("Sheet1")
    
    ' 获取目标表A列最后一行数据的行号
    lastRow = targetWS.Cells(targetWS.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历目标表的每一行（假设第1行是表头，从第2行开始填充）
    For i = 2 To lastRow
        ' 捕获找不到匹配项的错误，避免脚本中断
        On Error Resume Next
        targetWS.Cells(i, "B").Value = Application.WorksheetFunction.VLookup( _
            targetWS.Cells(i, "A").Value, _
            sourceWS.Range("A:B"), _
            2, _
            False _
        )
        On Error GoTo 0
        
        ' 可选：给无匹配项的单元格设置提示文本
        If IsEmpty(targetWS.Cells(i, "B").Value) Then
            targetWS.Cells(i, "B").Value = "无匹配数据"
        End If
    Next i
    
    MsgBox "填充完成", vbInformation
End Sub

进阶版本（自动打开数据源工作簿） #

如果需要脚本自动打开Workbook1，不用手动提前打开，可以用这个版本：

Sub FillRequirementAutoOpenSource()
    Dim sourceWB As Workbook
    Dim sourceWS As Worksheet
    Dim targetWS As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim sourcePath As String
    
    ' 替换成Workbook1的实际文件路径
    sourcePath = "C:\Documents\Workbook1.xlsx"
    
    ' 检查数据源是否已打开，未打开则自动打开
    On Error Resume Next
    Set sourceWB = Workbooks(Dir(sourcePath))
    On Error GoTo 0
    If sourceWB Is Nothing Then
        Set sourceWB = Workbooks.Open(sourcePath)
    End If
    
    Set sourceWS = sourceWB.Worksheets("Sheet1")
    ' 如果脚本在Workbook2中运行，直接用ThisWorkbook指代当前工作簿
    Set targetWS = ThisWorkbook.Worksheets("Sheet1")
    
    lastRow = targetWS.Cells(targetWS.Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To lastRow
        On Error Resume Next
        targetWS.Cells(i, "B").Value = Application.WorksheetFunction.VLookup( _
            targetWS.Cells(i, "A").Value, _
            sourceWS.Range("A:B"), _
            2, _
            False _
        )
        On Error GoTo 0
        
        If IsEmpty(targetWS.Cells(i, "B").Value) Then
            targetWS.Cells(i, "B").Value = "无匹配数据"
        End If
    Next i
    
    ' 可选：填充完成后自动关闭数据源工作簿（不保存修改）
    ' sourceWB.Close SaveChanges:=False
    
    MsgBox "填充完成", vbInformation
End Sub

注意事项 #

• 替换代码中的工作簿名称、工作表名称、文件路径为你的实际信息
• 如果目标表的Order Types没有表头，把循环起始行i=2改成i=1
• 不需要"无匹配数据"提示的话，直接删掉对应的判断代码即可

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