Найти дубликаты строк на основе двух столбцов и перенести результаты в другой лист

Question

У меня есть лист («Saisie de Données»), содержащий данные в столбцах B и D, которые иногда являются дубликатами. Я хотел бы иметь возможность распознавать эти дубликаты и суммировать данные в столбцах G-V. Затем результат будет перенесен на другой лист («Sommaire - Paie»), который получит неповторяющиеся строки с соответствующими данными и дубликат строки с результатами суммирования. Все столбцы остаются одинаковыми между двумя листами, за исключением столбца C, который не копируется в новый лист. Каждый раз, когда будет запущен макрос, данные на втором рабочем листе («Sommaire - Paie») будут перезаписываться.

Я приложил копию рабочей таблицы с данными для анализа («Saisie de Données») и ожидаемым результатом («Sommaire - Paie»), который я создал вручную.

Чтобы получить прикрепленный файл, перейдите по этой ссылке.

В настоящей рабочей тетради гораздо больше строк, но это всегда один и тот же шаблон: имя работника с часами, которые он провел в течение недели.

Answer 1

Я получил помощь от парня по имени Йойо Цзян, и код работает отлично. Вот код, который я использовал:

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