匹配2列，并从第三列产生

Question

需要帮助以比较（匹配）2列中的2列，如果匹配的话，第二板的第三列返回值。

    With Range("B3:B" & Range("A" & Rows.Count).End(xlUp).Row)
        .Formula = "=INDEX($D:$D,MATCH(1,(Sheet1!B$1=Sheet2!$C:$C)*(Sheet1!$A3=Sheet2!$A:$A),0))"
        .Value = .Value
    End With

表1：

表2：

​因此，尝试使用功能，但需要一个更好的代码，该代码应该更快。任何建议..

Answer 1

使用字典词典匹配列

Sub MatchColumns()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet2")
    Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion ' ("A1:D13")
    Dim rCount As Long: rCount = srg.Rows.Count - 1
    Dim Data As Variant: Data = srg.Resize(rCount).Offset(1).Value ' ("A2:D13")
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim Key As Variant
    Dim r As Long

    For r = 1 To rCount
        Key = Data(r, 1)
        If Not dict.Exists(Key) Then
            Set dict(Key) = CreateObject("Scripting.Dictionary")
        End If
        dict(Key)(Data(r, 3)) = Data(r, 4)
    Next r
    
    ' Print the contents of the dictionary in the Immediate window (Ctrl+G).
'    Dim iKey As Variant
'    For Each Key In dict.Keys
'        Debug.Print Key
'        For Each iKey In dict(Key).Keys
'            Debug.Print iKey
'        Next iKey
'    Next Key
    
    Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet1")
    
    Dim drrg As Range ' The Row (Column Labels, Headers) ' ("B1:E1")
    Set drrg = dws.Range("B1", dws.Cells(1, dws.Columns.Count).End(xlToLeft))
    Dim rData As Variant: rData = drrg.Value
    Dim cCount As Long: cCount = drrg.Columns.Count
    
    Dim dcrg As Range ' The Column (Row Labels) ' ("A3:A5")
    Set dcrg = dws.Range("A3", dws.Cells(dws.Rows.Count, "A").End(xlUp))
    Dim cData As Variant: cData = dcrg.Value
    rCount = dcrg.Rows.Count
    
    ReDim Data(1 To rCount, 1 To cCount)
    
    Dim c As Long
    
    For r = 1 To rCount
        Key = cData(r, 1)
        If dict.Exists(Key) Then
            For c = 1 To cCount
                If dict(Key).Exists(rData(1, c)) Then
                    Data(r, c) = dict(Key)(rData(1, c))
                End If
            Next c
        End If
    Next r
    
    dws.Range("B3").Resize(rCount, cCount).Value = Data ' ("B3:E5")
    
End Sub

Answer 2

如果您拥有Excel 365，则可以使用过滤器轻松地做到这一点：

我在单元格4中的公式是：

=FILTER($D$2:$D$13;($A$2:$A$13=$F4)*($C$2:$C$13=G$2))

拖动到右下，

如果您没有Excel 365，则可以使用complext公式：

=INDEX($D$1:$D$13;SUMPRODUCT(--($A$2:$A$13=$F4)*--($C$2:$C$13=G$2)*FILA($D$2:$D$13)))

请注意，零件sumproduct（ - （$ a $ 2：$ a $ 13 = $ f4）* - （$ c $ 2：$ c $ c $ 13 = g $ 2）*fila（$ d $ 2：$ d $ 13））将返回数据所在的位置的绝对行号，因此您需要在索引中返回整个列或正确提取的索引（这就是为什么我从第1行（包括标头）中选出的原因是索引的第一个参数）。

Answer 3

这使用阵列公式同时填充B3：E6

With Sheet1.Range("B3:E" & Sheet1.Cells(Rows.Count, 1).End(xlUp).Row)
    .FormulaArray = "=INDEX(Sheet2!$D$2:$D$13,MATCH(Sheet1!A3:A5&Sheet1!B1:E1,Sheet2!A2:A13&Sheet2!C2:C13,0))"
    .Value2 = .Value2
End With