求跨工作表精确匹配的Excel VBA版Index Match代码

你的原代码中Match函数已指定第三个参数0（精确匹配），出现近似匹配问题大概率是数据类型不匹配（比如Sheet1的B列是文本格式，Sheet2的G列是数字格式，反之亦然），或是代码的错误处理逻辑、范围效率问题导致。以下是优化后的精确匹配代码：

Sub ExactIndexMatch()
    Dim wsSource As Worksheet
    Dim wsLookup As Worksheet
    Dim lastRowSource As Long
    Dim lastRowLookup As Long
    Dim i As Long
    Dim matchVal As Variant
    Dim lookupRange As Range
    
    ' 定义工作表对象
    Set wsSource = ThisWorkbook.Sheets("Sheet1") ' 存放待匹配数据的工作表
    Set wsLookup = ThisWorkbook.Sheets("Sheet2") ' 存放匹配数据源的工作表
    
    ' 获取有效数据行（避免整列遍历，提升效率）
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
    lastRowLookup = wsLookup.Cells(wsLookup.Rows.Count, "G").End(xlUp).Row
    Set lookupRange = wsLookup.Range("G2:G" & lastRowLookup) ' 假设Sheet2的G列数据从第2行开始
    
    ' 遍历Sheet1的待匹配数据（从第4行开始，对应你的代码逻辑）
    For i = 4 To lastRowSource
        ' 强制转换为文本类型匹配，避免数据类型不一致导致的匹配失败/错误匹配
        matchVal = Application.Match(CStr(wsSource.Cells(i, "B").Value), lookupRange, 0)
        
        ' 判断匹配结果
        If Not IsError(matchVal) Then
            ' 匹配成功，提取Sheet2中M列对应行的数据
            wsSource.Cells(i, "C").Value = wsLookup.Cells(matchVal + 1, "M").Value ' 因为lookupRange从第2行开始，所以+1
        Else
            ' 匹配失败，填充NA
            wsSource.Cells(i, "C").Value = "NA"
        End If
    Next i
End Sub

关键改进说明 #

• 强制类型统一：用CStr()将匹配值转换为文本，解决文本/数字格式不一致导致的非精确匹配问题。
• 缩小匹配范围：不再遍历整列G:G，而是仅使用Sheet2中G列的有效数据范围，大幅提升运行效率。
• 更安全的匹配逻辑：使用Application.Match替代WorksheetFunction.Match，无需依赖On Error Resume Next，直接通过IsError()判断匹配结果，代码逻辑更清晰。
• 修正注释与逻辑对应：明确标注工作表角色和数据起始行，避免注释与代码逻辑冲突。

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