☰

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

tag-icon • tag-icon microsoft-excel-2007 vba
Suchen Sie doppelte Zeilen basierend auf zwei Spalten und übertragen Sie die Ergebnisse in ein anderes Arbeitsblatt

Ich habe ein Arbeitsblatt („Datensätze“), das Daten in den Spalten B und D enthält, die manchmal Duplikate sind. Ich möchte diese Duplikate erkennen und die Daten in den Spalten G bis V summieren können. Das Ergebnis würde dann in ein anderes Arbeitsblatt („Datensatz“) übertragen, das die nicht duplizierten Zeilen mit ihren zugehörigen Daten und die duplizierte Zeile mit den Summenergebnissen erhält. Alle Spalten bleiben in den beiden Arbeitsblättern gleich, mit Ausnahme der Spalte C, die nicht in das neue Arbeitsblatt kopiert wird. Jedes Mal, wenn das Makro gestartet wird, werden die Daten im zweiten Arbeitsblatt („Datensatz“) überschrieben.

Ich habe eine Kopie des Arbeitsblatts mit den zu analysierenden Daten („Saisie de Données“) und dem erwarteten Ergebnis („Sommaire – Paie“) angehängt, das ich manuell erstellt habe.

Um die angehängte Datei zu erhalten, folgen Siedieser Dropbox-Link.

Im echten Arbeitsbuch gibt es zwar deutlich mehr Zeilen, aber es folgt immer das gleiche Muster: der Name des Arbeiters mit der Anzahl der Stunden, die er in der Woche gearbeitet hat.

Antwort1

Ich habe Hilfe von einem Typen namens Yoyo Jiang bekommen 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

verwandte Informationen