如何匹配多列并获得价值？答案

【问题标题】：How to match multiple columns and get value?如何匹配多列并获得价值？
【发布时间】：2022-08-14 12:31:29
【问题描述】：

我试图匹配两个表中的值并复制目标表中的值。

我知道这需要多个循环/条件。

目标是使用帮助表 (SA) 中的匹配将匹配值从源表 (SE) 复制到目标表 (FB) 中的每一行。

我想要达到的目标：

表 \'SA\' 的 \'C\' 列中没有唯一键值。

到目前为止我的代码：

Sub MatchTables()

    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim i As Long, j As Long
    Dim newSheetPos As Integer

    Set ws1 = ActiveWorkbook.Sheets(\"FB\") \'Range: last row
    Set ws2 = ActiveWorkbook.Sheets(\"SA\") \'Range: rows 5 to 84
    Set ws3 = ActiveWorkbook.Sheets(\"SE\") \'Range: last row

    For i = 2 To ws1.Cells(ws1.Rows.Count, 3).End(xlUp).Row
        For j = 5 To 84

            If ws1.Cells(i, 3).Value = ws2.Cells(j, 3).Value Then
                If ws2.Cells(i, 3).Value = ws3.Cells(j, 5).Value Then
                    ws3.Cells(j, 6).Copy ws1.Cells(i , 16)
                Else
                End If
            Else
            End If

        Next j
    Next i
End Sub

标签： excel vba loops lookup matching

【解决方案1】：

（超级）双重查找

为简化起见，假设每个查找列至少包含 2 行数据，并且没有错误值或空白。

Sub SuperLookup()

    Const sName As String = "SE"
    Const sfRow As Long = 2
    Const slCol As String = "E" ' 4.) ... here and return...
    Const svCol As String = "F" ' 5.) ... this...
    
    Const lName As String = "SA"
    Const lRowsAddress As String = "5:84"
    Const llCol As String = "C" ' 2.) ... here and return...
    Const lvCol As String = "Q" ' 3.) ... this to look it up...
    
    Const dName As String = "FB"
    Const dfRow As Long = 2
    Const dlCol As String = "C" ' 1.) Look up this...
    Const dvCol As String = "P" ' 6.) ... here.
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, slCol).End(xlUp).Row
    Dim srg As Range
    Set srg = sws.Cells(sfRow, slCol).Resize(slRow - sfRow + 1)
    Dim sData As Variant: sData = srg.EntireRow.Columns(svCol).Value
    
    Dim lws As Worksheet: Set lws = wb.Worksheets(lName)
    Dim lrg As Range: Set lrg = lws.Rows(lRowsAddress).Columns(llCol)
    Dim lData As Variant: lData = lrg.EntireRow.Columns(lvCol).Value
    
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    Dim dlRow As Long: dlRow = dws.Cells(dws.Rows.Count, dlCol).End(xlUp).Row
    Dim drCount As Long: drCount = dlRow - dfRow + 1
    Dim drg As Range: Set drg = dws.Cells(dfRow, dlCol).Resize(drCount)
    Dim dlData As Variant: dlData = drg.Value
    Set drg = drg.EntireRow.Columns(dvCol)
    Dim dvData As Variant: ReDim dvData(1 To drg.Rows.Count, 1 To 1)
    
    Dim sIndex As Variant
    Dim lIndex As Variant
    Dim lValue As Variant
    Dim dValue As Variant
    Dim dr As Long
    
    For dr = 1 To drCount
        dValue = dlData(dr, 1)
        lIndex = Application.Match(dValue, lrg, 0)
        If IsNumeric(lIndex) Then
            lValue = lData(lIndex, 1)
            sIndex = Application.Match(lValue, srg, 0)
            If IsNumeric(sIndex) Then
                dvData(dr, 1) = sData(sIndex, 1)
            'Else ' not found in source; do nothing
            End If
        'Else ' not found in lookup; do nothing
        End If
    Next dr

    drg.Value = dvData
    
    MsgBox "Super lookup has finished.", vbInformation

End Sub

【讨论】：