☰

Encontre linhas duplicadas com base em duas colunas e transfira os resultados para outra planilha

tag-icon • tag-icon microsoft-excel-2007 vba
Encontre linhas duplicadas com base em duas colunas e transfira os resultados para outra planilha

Tenho uma planilha ("Saisie de Données") contendo dados nas colunas B e D que às vezes são duplicados. Gostaria de poder reconhecer essas duplicatas e somar os dados das colunas G a V. O resultado seria então transferido para outra planilha ("Sommaire - Paie") que receberá as linhas não duplicadas com seus dados relacionados e a linha duplicada com os resultados da soma. Todas as colunas permanecem iguais entre as duas planilhas, exceto a coluna C que não é copiada para a nova planilha. Cada vez que a macro for iniciada, os dados da segunda planilha ("Sommaire - Paie") serão sobrescritos.

Anexei uma cópia da planilha com os dados a serem analisados ​​("Saisie de Données") e o resultado esperado ("Sommaire - Paie") que criei manualmente.

Para obter o arquivo anexado, sigaeste link da caixa de depósito.

Na carteira de trabalho real tem muito mais linhas, mas é sempre o mesmo padrão: o nome do trabalhador com as horas que ele cumpriu durante a semana.

Responder1

Recebi ajuda de um cara chamado Yoyo Jiang e o código funciona perfeitamente. Aqui está o código que usei:

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

informação relacionada