Suchen Sie doppelte Zeilen basierend auf zwei Spalten und übertragen Sie die Ergebnisse in ein anderes Arbeitsblatt

Ich habe ein Arbeitsblatt ("Saisie de Données") mit Daten in Spalte B und D, die manchmal doppelt vorhanden sind. Ich möchte diese Duplikate erkennen und die Daten in den Spalten G bis V summieren können. Das Ergebnis wird dann in ein anderes Arbeitsblatt ("Sommaire - Paie") übertragen, das die nicht-duplizierten Zeilen mit den zugehörigen Daten und enthält die doppelte Zeile mit den Summenergebnissen. Alle Spalten zwischen den beiden Arbeitsblättern bleiben gleich, mit Ausnahme der Spalte C, die nicht in das neue Arbeitsblatt kopiert wird. Bei jedem Start des Makros werden die Daten im zweiten Arbeitsblatt ("Sommaire - Paie") überschrieben.

Ich habe eine Kopie des Arbeitsblatts mit den zu analysierenden Daten ("Saisie de Données") und dem von mir manuell erstellten Ergebnis ("Sommaire - Paie") angehängt.

Folgen Sie diesem Dropbox-Link, um die angehängte Datei abzurufen .

In der realen Arbeitsmappe gibt es viel mehr Zeilen, aber es ist immer dasselbe Muster: der Name des Arbeitnehmers mit den Stunden, die er während der Woche tat.

Ich habe Hilfe von einem Typen namens Yoyo Jiang erhalten, und der Code funktioniert einwandfrei. Hier ist der Code, den ich verwendet habe:

Private Sub TestSumDuplicate()

Dim WS1 As Worksheet
Dim WS2 As Worksheet
Set WS1 = ThisWorkbook.Worksheets("Saisie de Données")
Set WS2 = ThisWorkbook.Worksheets("Sommaire - Paie (2)")

Dim oRange1 As Range
Dim oRange2 As Range
Dim tempRange As Range

Set oRange2 = WS2.Range("A29", "U110")
oRange2.ClearContents
Set oRange1 = WS1.Range("A30", "V553")

Dim i As Integer
Dim j As Integer
Dim t As Integer
Dim m As Integer
Dim n As Integer

Dim bFlag As Boolean

' j to record the current relative row location in oRange2
j = 1

For i = 0 To oRange1.Rows.Count - 1

bFlag = False '' to record if there is already a same category in oRange2.

If Not oRange1.Cells(i, 2) = "" Then
If Not oRange1.Cells(i, 2) = "Ligne Sommaire" Then

'' If it a row need to be check
For t = 1 To j
If oRange2.Cells(t, 3) = oRange1.Cells(i, 4) And oRange2.Cells(t, 2) = oRange1.Cells(i, 2) Then
bFlag = True

    '' Sum if duplicate
    For m = 0 To 18
    If Not oRange1.Cells(i, 7 + m) = "" Then
        oRange2.Cells(t, 6 + m) = oRange1.Cells(i, 7 + m) + oRange2.Cells(t, 6 + m)
    End If
    Next m

Exit For
End If
Next t

If bFlag = True Then
    bFlag = False
Else
    '' doesn't find a duplicate value
    oRange2.Cells(j, 1) = oRange1.Cells(i, 1)
    oRange2.Cells(j, 2) = oRange1.Cells(i, 2)

    For m = 4 To 25
     oRange2.Cells(j, m - 1) = oRange1.Cells(i, m)
    Next m

    j = j + 1
End If

End If
End If
Next i

End Sub