[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.
A voir également:
- [EXCEL] Suppression lignes + compteur
- Forcer suppression fichier - Guide
- Liste déroulante excel - Guide
- Word et excel gratuit - Guide
- Si ou excel - Guide
- Déplacer colonne excel - Guide
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)
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.
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.
