匹配 2 列和第 3 列的結果

Question

需要幫助比較（匹配）2 張表中的 2 列，如果匹配則從第 2 張表的第 3 列返回值。

    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 頁：

如果我在每個單元格中放置公式（整月），這個 Function 比平時花費的時間更長。 所以用 function 試試這個，但需要一個更好的代碼，它應該運行得更快。 有什么建議么..

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，您可以使用 FILTER 輕松實現：

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

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

向右和向下拖動

如果你沒有 Excel 365 你可以用一個復雜的公式來完成：

=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$13=G$2)*FILA($D$2:$D$13))部分將返回數據所在位置的絕對行號，因此在 INDEX 中您需要引用整列或正確減去（這就是為什么我從第 1 行中選擇包括標題作為 INDEX 的第一個參數）。

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