[EXCEL] Suppression lignes + compteur
djey76
-
Djey76 -
Djey76 -
Bonjour,
Je dois traiter une base de données de 14000 lignes et 5 colonnes. Cependant il existe plein de doublon et j'aimerais avoir une macro qui me recherche les doublons (les 5 colonnes identiques), les compte, met le résultat dans une 6e colonne et supprime les lignes identiques. Par exemple si j'ai 5 fois la même ligne je veux en garder qu'une avec dans 6e colonne le chiffre 5. Pouvez vous m'aider à concevoir cette macro car ma connaissance dans ce language est quasi nulle.
Merci d'avance.
Je dois traiter une base de données de 14000 lignes et 5 colonnes. Cependant il existe plein de doublon et j'aimerais avoir une macro qui me recherche les doublons (les 5 colonnes identiques), les compte, met le résultat dans une 6e colonne et supprime les lignes identiques. Par exemple si j'ai 5 fois la même ligne je veux en garder qu'une avec dans 6e colonne le chiffre 5. Pouvez vous m'aider à concevoir cette macro car ma connaissance dans ce language est quasi nulle.
Merci d'avance.
Configuration: Windows XP Internet Explorer 6.0 Excel 2003
2 réponses
-
bonjour
Comme ton exposé me parait clair voici une macro qui devrait répondre à la demande.
Tu peux la mettre dans la feuille de ta base qui doit être active (mode d'emploi)Public Sub sup_doubles() Dim c As Integer ' colonne Dim ctr As Long ' compteur lignes doubles Dim l As Long ' ligne For c = 5 To 1 Step -1 ' tri des données Cells.Sort Key1:=Cells(1, c), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Next c Cells(1, 6).EntireColumn.ClearContents ' effacement nb doubles ctr = 0 For l = Cells.SpecialCells(xlCellTypeLastCell).Row To 2 Step -1 For c = 1 To 5 ' les 5 colonnes identiques ? If Cells(l, c).Value <> Cells(l - 1, c).Value Then Exit For Next c If c = 6 Then ' les 5 colonnes sont identiques Cells(l - 1, 6).Value = Cells(l, 6).Value + 1 ' comptage Rows(l).Delete ' suppression ctr = ctr + 1 ' addition End If Next l MsgBox "Vous aviez " & ctr & " lignes en double qui ont été supprimées" End Sub
La macro ne peux fonctionner qu'une seule fois car au deuxième passage il n'y a plus de doubles.
Donc sauvegarder sous un autre nom pour garder le classeur initial. -
