针对你需要合并同一工作簿中「List Import」和「List Export」数据到新工作表的需求，你自己编写的这段VBA代码已经能很好地完成任务！我帮你整理并补充一些细节说明：

问题回顾 #

现有两个工作表，均包含From/To/Value列，需要以From+To的组合为唯一键，将两个表的Value分别对应到新表的Import和Export列，处理约400行数据并批量应用到多个工作簿。

可用VBA代码 #

Sub combolist()
    Dim lastRowImp As Long, lastRowExp As Long, startPaste As Long, endPaste As Long
    Dim ws As Worksheet, Lookup_Range As Range, i As Integer
    Dim lastRow As Long
    
    ' 获取两个源表的最后行号
    lastRowImp = Sheets("List Import").Cells(Rows.Count, 1).End(xlUp).Row
    lastRowExp = Sheets("List Export").Cells(Rows.Count, 1).End(xlUp).Row
    startPaste = lastRowImp + 1
    endPaste = lastRowImp + lastRowExp - 1
    
    ' 创建目标工作表并设置表头
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Combolist"
    With Sheets("Combolist")
        .Range("B1") = "Import"
        .Range("C1") = "Export"
        .Range("C1").EntireRow.Font.Bold = True
    End With
    
    ' 复制两个源表的国家组合列到目标表
    Sheets("Combolist").Range("A1:A" & lastRowImp) = Sheets("List Import").Range("C1:C" & lastRowImp).Value
    Sheets("Combolist").Range("A" & startPaste & ":A" & endPaste) = Sheets("List Export").Range("C2:C" & lastRowExp).Value
    
    ' 移除目标表中的重复国家组合
    lastRow = Sheets("Combolist").Cells(Rows.Count, 1).End(xlUp).Row
    Sheets("Combolist").Range(Cells(1, 1), Cells(lastRow, 1)).RemoveDuplicates Columns:=Array(1), Header:=xlYes
    
    Set ws = ActiveWorkbook.Sheets("Combolist")
    lastRow = Sheets("Combolist").Cells(Rows.Count, 1).End(xlUp).Row
    
    ' 填充Import列数据
    Set Lookup_Range = Sheets("List Import").Range("C1:D" & lastRowImp)
    With ws
        For i = 2 To lastRow
            On Error Resume Next
            If Application.WorksheetFunction.VLookup(ws.Cells(i, 1), Lookup_Range, 2, False) = "" Then
                ws.Cells(i, 2) = 0
            Else
                ws.Cells(i, 2) = Application.WorksheetFunction.VLookup(ws.Cells(i, 1), Lookup_Range, 2, False)
            End If
            On Error GoTo 0 ' 恢复错误捕获
        Next i
    End With
    
    ' 填充Export列数据
    Set Lookup_Range = Sheets("List Export").Range("C1:D" & lastRowExp)
    With ws
        For i = 2 To lastRow
            On Error Resume Next
            If Application.WorksheetFunction.VLookup(ws.Cells(i, 1), Lookup_Range, 2, False) = "" Then
                ws.Cells(i, 3) = 0
            Else
                ws.Cells(i, 3) = Application.WorksheetFunction.VLookup(ws.Cells(i, 1), Lookup_Range, 2, False)
            End If
            On Error GoTo 0 ' 恢复错误捕获
        Next i
    End With
End Sub

代码核心逻辑说明 #

• 创建目标表：在工作簿末尾新增「Combolist」工作表，设置表头并加粗
• 生成唯一匹配键：利用你在两个源表中新增的C列（国家组合）作为匹配依据，将所有组合复制到目标表
• 去重处理：移除目标表中重复的国家组合，确保每个组合只出现一次
• 匹配填充数据：通过VLookup函数，分别将「List Import」和「List Export」中的对应值填充到目标表的Import和Export列，无匹配项时自动填充0

优化小建议 #

1. 错误处理优化：原代码中的On Error Resume Next会掩盖所有错误，建议改用Application.VLookup（不带WorksheetFunction）来处理无匹配的情况，更安全清晰：

   Dim result As Variant
   result = Application.VLookup(ws.Cells(i, 1), Lookup_Range, 2, False)
   ws.Cells(i, 2) = IIf(IsError(result), 0, result)
   

2. 批量处理多个工作簿：如果需要对多个工作簿执行此操作，可以添加循环遍历指定文件夹下的所有Excel文件，打开后执行这段代码再保存关闭
3. 列引用灵活性：如果源表的列位置可能变动，可以定义常量来存储列索引，方便后续修改

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