Wie lassen sich zwei Kriterien in Arrays abgleichen?

Wie lassen sich zwei Kriterien in Arrays abgleichen?

Ich brauche in dieser Angelegenheit wirklich Ihre Hilfe, bitte!

Ich habe keinen Fehler, alles funktioniert reibungslos....

Ich brauche nur, dass außer der 1:1-Spalte auch die 2:2-Spalten abgeglichen werden.

Spalte A im Quellblatt zu Spalte G im Zielblatt (bereits hier). Ich möchte außerdem Spalte B im Quellblatt zu Spalte H im Zielblatt hinzufügen.

Zusammenfassung: Ordnen Sie 2 Spalten im Quellblatt (A und B) 2 Spalten im Zielblatt (G und H) zu.

Ich hoffe, Sie haben meine Frage verstanden? Danke!

Erster Teil des Codes: Kein Problem

Sub Get_Data()

Const NUM_DATA_COLS As Long = 4

Dim SourceSheet As Worksheet, TargetSheet As Worksheet
Set SourceSheet = GetWorkbook(Source).Worksheets("Data")
Set TargetSheet = ThisWorkbook.Worksheets("Sheet2")

Dim SourceLastRow As Long, TargetLastRow As Long
SourceLastRow = SourceSheet.Cells(Rows.Count, 1).End(xlUp).Row
TargetLastRow = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row

Dim Primary_Fields(1 To NUM_DATA_COLS), Foreign_Fields(1 To NUM_DATA_COLS), n As Long
Dim i As Long, v, m

Dim rngPrimary_Key As Range 
Dim Foreign_Key As Variant 

Zweiter Teil des Codes:

So fügen Sie einen weiteren (rngPrimary_Key2) und (Foreign_Key2) hinzu, um 2 Spalten mit 2 Spalten abzugleichen

Ich vergleiche nur diese
Set rngPrimary_Key = SourceSheet.Range("A2:A" & SourceLastRow) Foreign_Key = TargetSheet.Range("G2:G" & TargetLastRow).Value

Ich muss diese zu den Übereinstimmungskriterien hinzufügen.
Set rngPrimary_Key2 = SourceSheet.Range("B2:B" & SourceLastRow)
Foreign_Key2 = TargetSheet.Range("H2:H" & TargetLastRow).Value

^- Wenn diese beiden Spalten in beiden Blättern übereinstimmen, dann in einem Array speichern, anstatt nur eine Spalte abzugleichen.

Set rngPrimary_Key = SourceSheet.Range("A2:A" & SourceLastRow)
Foreign_Key = TargetSheet.Range("G2:G" & TargetLastRow).Value

For n = 1 To NUM_DATA_COLS
    Primary_Fields(n) = SourceSheet.Range("B2:B" & SourceLastRow).Offset(0, n - 1).Value
    Foreign_Fields(n) = EmptyCopy(Foreign_Key) 'empty array for results
Next n

' get matching rows and copy values to arrays
For i = LBound(Foreign_Key, 1) To UBound(Foreign_Key, 1)
    v = Foreign_Key(i, 1)
    m = Application.Match(v, rngPrimary_Key, 0)
    If Not IsError(m) Then            'check got a match
        For n = 1 To NUM_DATA_COLS
            Foreign_Fields(n)(i, 1) = Primary_Fields(n)(m, 1)
        Next n
    End If
Next i

' / Write (Keys-IndexMatch) in Range offset Foreign_Field_1 2
Place2DArray TargetSheet.Range("H2"), Foreign_Fields(1)
Place2DArray TargetSheet.Range("i2"), Foreign_Fields(2)
Place2DArray TargetSheet.Range("J2"), Foreign_Fields(3)
Place2DArray TargetSheet.Range("K2"), Foreign_Fields(4)

End Sub

Der Rest des Codes hat nichts mit meiner Frage zu tun

'return an empty array of same dimensions as 'arr'

 Function EmptyCopy(arr)
Dim rv
ReDim rv(LBound(arr, 1) To UBound(arr, 1), LBound(arr, 2) To UBound(arr, 2))
EmptyCopy = rv
End Function

'copy a 1-based 2-d array 'arr' to a worksheet, starting at cell 'c'
Sub Place2DArray(c As Range, arr)
c.Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub      

verwandte Informationen