匹配 2 列和第 3 列的结果

Question

需要帮助来比较（匹配）来自 2 sheet 的 2 列和来自第 2 sheet 的第 3 列的 return 值（如果匹配）。

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

Sheet 1:

Sheet 2:

如果我在每个单元格中放置公式（整月），此函数将花费比平时更长的时间。所以尝试这个 With 函数，但需要一个更好的代码，它应该运行更快。任何建议..

Answer 1

如果你有 Excel 365，你可以使用 FILTER 轻松做到这一点：

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

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

向右和向下拖动

如果您没有 Excel 365，您可以使用复杂的公式来完成：

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

请注意 SUMPRODUCT(--($A:$A=$F4)*--($C:$C=G)*FILA($D:$D)) 部分将 return 数据所在位置的绝对行号，因此在 INDEX 中您需要引用整列或正确减去（这就是我选择 from row 的原因1 包括 headers 作为 INDEX 的第一个参数）。

Answer 2

这使用数组公式同时填充 B3:E6

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

Answer 3

使用字典中的字典匹配列

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

匹配 2 列和第 3 列的结果

Match 2 Columns and Result from 3rd Column

excel

vba

compare

multiple-columns

使用字典中的字典匹配列