☰

Encuentre filas duplicadas basadas en dos columnas y transfiera los resultados a otra hoja de trabajo

tag-icon • tag-icon microsoft-excel-2007 vba
Encuentre filas duplicadas basadas en dos columnas y transfiera los resultados a otra hoja de trabajo

Tengo una hoja de trabajo ("Saisie de Données") que contiene datos en las columnas B y D que a veces están duplicados. Me gustaría poder reconocer estos duplicados y sumar los datos de las columnas G a V. El resultado luego se transferiría a otra hoja de trabajo ("Sommaire - Paie") que recibirá las filas no duplicadas con sus datos relacionados y la fila duplicada con los resultados de la suma. Todas las columnas permanecen iguales entre las dos hojas de trabajo, excepto la columna C que no se copia a la nueva hoja de trabajo. Cada vez que se ejecute la macro, se sobrescribirán los datos de la segunda hoja de trabajo ("Sommaire - Paie").

Adjunté una copia de la hoja de trabajo con los datos a analizar ("Saisie de Données") y el resultado esperado ("Sommaire - Paie") que creé manualmente.

Para obtener el archivo adjunto, sigaeste enlace de dropbox.

En el libro de trabajo real hay muchas más líneas, pero siempre es el mismo patrón: el nombre del trabajador con las horas que realizó durante la semana.

Respuesta1

Recibí ayuda de un tipo llamado Yoyo Jiang y el código funciona perfectamente. Aquí está el código que utilicé:

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

información relacionada