1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
|
Sub GererDoublons()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim newRow As Long
Dim dict As Object
Dim key As String
Dim doublons As Collection
' Définir la feuille de calcul active
Set ws = ActiveSheet
' Trouver la dernière ligne utilisée dans la colonne A
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' Initialiser un dictionnaire pour stocker les doublons
Set dict = CreateObject("Scripting.Dictionary")
' Parcourir les lignes du tableau
For i = 2 To lastRow
' Vérifier que la valeur de la colonne D n'est pas 9 ou 0
If ws.Cells(i, "D").Value <> 9 And ws.Cells(i, "D").Value <> 0 Then
' Créer une clé basée sur Colonne D et Colonne G
key = ws.Cells(i, "D").Value & "_" & ws.Cells(i, "G").Value
' Vérifier si la clé existe déjà
If dict.exists(key) Then
dict(key).Add i
Else
Set doublons = New Collection
doublons.Add i
dict.Add key, doublons
End If
End If
Next i
' Traiter les doublons trouvés
For Each key In dict.Keys
If dict(key).Count > 1 Then
' Insérer une nouvelle ligne sous les doublons
newRow = dict(key).Item(dict(key).Count) + 1
ws.Rows(newRow).Insert Shift:=xlDown
' Copier les informations des doublons
ws.Cells(newRow, "A").Value = ws.Cells(dict(key).Item(1), "A").Value
ws.Cells(newRow, "D").Value = ws.Cells(dict(key).Item(1), "D").Value
ws.Cells(newRow, "E").Value = ws.Cells(dict(key).Item(1), "E").Value
ws.Cells(newRow, "G").Value = ws.Cells(dict(key).Item(1), "G").Value
' Calculer la somme des valeurs en colonne F
Dim somme As Double
somme = 0
For Each i In dict(key)
somme = somme + ws.Cells(i, "F").Value
Next i
ws.Cells(newRow, "F").Value = somme
' Mettre la nouvelle ligne en gras
ws.Rows(newRow).Font.Bold = True
End If
Next key
End Sub |
Partager