场景回顾 #

你有两个工作簿：

• WorkbookA.Sheet1：

• WorkbookB.Sheet1：

你已经完成了基础的Value匹配，现在需要借助Dictionary识别不匹配的Country，并添加对应的匹配条件（比如标记缺失项、记录待补充内容等）。

完整VBA代码实现 #

Sub MatchValuesAndHandleMismatches()
    Dim wbA As Workbook, wbB As Workbook
    Dim wsA As Worksheet, wsB As Worksheet
    Dim countryDict As Object
    Dim lastRowA As Long, lastRowB As Long
    Dim i As Long, j As Long
    Dim currentCountry As String
    Dim mismatchSheet As Worksheet
    
    ' 初始化工作簿对象（注意：确保WorkbookB已打开，或者修改路径）
    Set wbA = ThisWorkbook ' 如果WorkA是当前打开的工作簿，否则改为Workbooks("WorkA.xlsx")
    Set wsA = wbA.Sheets("Sheet1")
    Set wbB = Workbooks("workB.xlsx")
    Set wsB = wbB.Sheets("Sheet1")
    
    ' 创建并配置Dictionary
    Set countryDict = CreateObject("Scripting.Dictionary")
    countryDict.CompareMode = vbTextCompare ' 不区分大小写，避免"A"和"a"被判定为不匹配
    
    ' 把WorkbookA的Country-Value数据加载到Dictionary
    lastRowA = wsA.Cells(wsA.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRowA ' 跳过表头，从第2行开始
        currentCountry = wsA.Cells(i, "A").Value
        ' 只添加唯一的Country（避免重复键）
        If Not countryDict.Exists(currentCountry) Then
            countryDict.Add currentCountry, wsA.Cells(i, "B").Value
        End If
    Next i
    
    ' 处理WorkbookB的匹配与不匹配项
    lastRowB = wsB.Cells(wsB.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRowB
        currentCountry = wsB.Cells(i, "A").Value
        If countryDict.Exists(currentCountry) Then
            ' 匹配成功，填充对应Value
            wsB.Cells(i, "B").Value = countryDict(currentCountry)
        Else
            ' 不匹配：标记为待补充，并记录到专门工作表
            wsB.Cells(i, "B").Value = "需补充匹配条件"
            
            ' 创建/获取"不匹配项记录"工作表
            On Error Resume Next
            Set mismatchSheet = wbB.Sheets("不匹配项记录")
            On Error GoTo 0
            If mismatchSheet Is Nothing Then
                Set mismatchSheet = wbB.Sheets.Add(After:=wbB.Sheets(wbB.Sheets.Count))
                mismatchSheet.Name = "不匹配项记录"
                ' 设置表头
                With mismatchSheet
                    .Cells(1, 1).Value = "未匹配Country"
                    .Cells(1, 2).Value = "来源工作簿"
                    .Cells(1, 3).Value = "处理状态"
                    .Rows(1).Font.Bold = True
                End With
            End If
            
            ' 写入不匹配记录
            j = mismatchSheet.Cells(mismatchSheet.Rows.Count, "A").End(xlUp).Row + 1
            mismatchSheet.Cells(j, 1).Value = currentCountry
            mismatchSheet.Cells(j, 2).Value = "WorkbookB"
            mismatchSheet.Cells(j, 3).Value = "待补充"
        End If
    Next i
    
    ' 可选：反向检查WorkbookA存在但WorkbookB没有的Country
    For i = 2 To lastRowA
        currentCountry = wsA.Cells(i, "A").Value
        ' 检查WorkbookB中是否存在该Country
        If wsB.Range("A:A").Find(currentCountry, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
            j = mismatchSheet.Cells(mismatchSheet.Rows.Count, "A").End(xlUp).Row + 1
            mismatchSheet.Cells(j, 1).Value = currentCountry
            mismatchSheet.Cells(j, 2).Value = "WorkbookA"
            mismatchSheet.Cells(j, 3).Value = "WorkbookB缺失"
        End If
    Next i
    
    ' 释放对象，避免内存泄漏
    Set countryDict = Nothing
    Set wsA = Nothing: Set wbA = Nothing
    Set wsB = Nothing: Set wbB = Nothing
    Set mismatchSheet = Nothing
    
    MsgBox "匹配操作完成！不匹配项已记录到「不匹配项记录」工作表。", vbInformation
End Sub

代码关键说明 #

1. Dictionary的优势：相比VLOOKUP，Dictionary的查找效率更高，尤其当数据量较大时，能显著提升运行速度。
2. 不区分大小写匹配：通过countryDict.CompareMode = vbTextCompare设置，避免因大小写差异导致的误判。
3. 不匹配项处理：
   • 直接在WorkbookB的Value列标记状态，方便直观查看；
   • 自动创建专门的记录工作表，汇总所有不匹配的Country及其来源，方便后续统一处理匹配条件。
4. 双向检查：不仅处理WorkbookB中不存在于WorkbookA的项，还反向检查WorkbookA有但WorkbookB缺失的项，覆盖所有不匹配场景。

自定义匹配条件添加 #

如果你需要更个性化的处理（比如自动添加空行到WorkbookA、弹出输入框让用户手动填写Value等），可以修改不匹配分支的代码：

示例：自动在WorkbookA末尾添加不匹配的Country，等待填充Value

Else
    ' 不匹配：在WorkbookA添加空行
    lastRowA = wsA.Cells(wsA.Rows.Count, "A").End(xlUp).Row + 1
    wsA.Cells(lastRowA, "A").Value = currentCountry
    wsA.Cells(lastRowA, "B").Value = "" ' 留空等待填充
    
    ' 更新WorkbookB的标记
    wsB.Cells(i, "B").Value = "已添加至WorkbookA待填充"
    
    ' 更新记录工作表
    j = mismatchSheet.Cells(mismatchSheet.Rows.Count, "A").End(xlUp).Row + 1
    mismatchSheet.Cells(j, 1).Value = currentCountry
    mismatchSheet.Cells(j, 2).Value = "WorkbookB"
    mismatchSheet.Cells(j, 3).Value = "已添加至WorkbookA"
End If

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