Excel-Makro zum Kopieren von Daten von einem Blatt auf ein anderes, basierend auf bestimmten Übereinstimmungsbedingungen

Ich habe zwei Blätter, von denen eines Daten für alle Übereinstimmungscodes enthält (Master Sheet) und das andere Daten für einige Übereinstimmungscodes enthält. Diese Codes sind mit einer Datennummer (sowie anderen Werten) verknüpft, die ich vom "Master Sheet" auf das andere Blatt übertragen muss. Anfangs habe ich die Indexübereinstimmung verwendet, um die Werte und die Datennummer zu übernehmen. Leider habe ich nicht bemerkt, dass es doppelte Übereinstimmungscodes gibt, die verschiedenen Werten und Datennummern entsprechen. Daher möchte ich in der Lage sein, Daten dort einzufügen, wo sie kopiert werden sollen Die Übereinstimmungscodes sind verknüpft, die Datennummer jedoch nicht. Beispielsweise

 Master Sheet

Match Code  Value 1   Value 2   Rate   data number
11111       1500      1200     2700      656565 
11111       1800      1800     3600      688888 
11112       1500      1100     2600      818987 
11112       1500      150      1650      986773 
12343       200       800      1000      785942

Sheet 2

Match Code  Value 1   Value 2   Rate   data number
11111       1500      1200     2700      656565  
11112       1500      150      1650      986773 

Wie zu sehen ist, weist Blatt 2 die Übereinstimmungscodes 11111 und 11112 auf, ebenso wie das Master-Blatt. Ich muss jedoch alle Daten mit entsprechenden Übereinstimmungswerten, aber unterschiedlichen Datennummern übermitteln. Ich kann jedoch nicht das gesamte Master-Blatt kopieren, da das Master-Blatt Übereinstimmungswerte enthält, die in Blatt 2 nicht gefunden wurden, z. B. 12343. Daher würde Blatt 2 nach Fertigstellung folgendermaßen aussehen:

Sheet 2

Match Code  Value 1   Value 2   Rate   data number
11111       1500      1200     2700      656565 
11111       1800      1800     3600      688888 
11112       1500      1100     2600      818987 
11112       1500      150      1650      986773  

Gibt es eine Möglichkeit, ein Makro zum Überprüfen der Übereinstimmungswerte in Blatt 2 und für jeden entsprechenden Übereinstimmungswert zwischen den Blättern zu erstellen? Wenn diese exakte Zeile nicht bereits in Blatt 2 enthalten ist, kopieren Sie die gesamte Zeile und fügen Sie sie in das Blatt ein 2?

Ich habe Folgendes, aber es macht nicht das, was ich will:

Sub pasteLoop()

'Iterator Worksheet 1, is the counter for the ws1 column
Dim iWS1 As Integer
'Iterator Worksheet 2, is the counter for the ws2 column
Dim iWS2 As Integer
'Switch New Row, is the switch if the next value need a new row
Dim sNR As Integer
'Maximal Row Count, need to be extend when new rows are added
Dim MaxRows As Integer
'valueHolder, is the holder for the orginal value, the orginal value might be replaced on the sheet
Dim valueHolder As Long

'Worksheet1
Dim ws1 As Worksheet
'Worlsheet2
Dim ws2 As Worksheet

Set ws1 = ActiveWorkbook.Worksheets("Sheet 2")
Set ws2 = ActiveWorkbook.Worksheets("Master Sheet")

'Set iWS1 to the first row
iWS1 = 1
'Get MaxRows
MaxRows = ws1.Cells(Rows.Count, 1).End(xlUp).Row

'Loop through the Rows on WS1 setting switch to 0 and store the value from the ws1 row in the holder
While iWS1 <= MaxRows
sNR = 0
valueHolder = ws1.Cells(iWS1, 1).Value

'Loop through the Rows on WS2, searching for a value that match with the value from ws1
For iWS2 = 1 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
    'When it matches, then look if there was already a match with the value, if not replace it on the ws1 and increase the sNr to 1
    If valueHolder = ws2.Cells(iWS2, 1).Value Then
        If (sNR < 1) Then
            ws1.Cells(iWS1, 1).Value = ws2.Cells(iWS2, 2).Value
            sNR = sNR + 1
        'When the sNR is already > 0, increase the Iterator for the ws1 that he will point on the new line
        'increase the maxrows because we got one more soon, finally insert the new row and store the value from ws2 in it
        Else
            iWS1 = iWS1 + 1
            MaxRows = MaxRows + 1
            Range(ws1.Cells(iWS1, 1), ws1.Cells(iWS1, 1)).EntireRow.Insert
            ws1.Cells(iWS1, 1).Value = ws2.Cells(iWS2, 2)
        End If
    End If
Next iWS2
iWS1 = iWS1 + 1
Wend


End Sub

Antworten auf die Frage(2)

Ihre Antwort auf die Frage