Discussion :

[amouna123456]

Bonjour,

j'aimerai créer une macro qui va me permettre de supprimer les lignes en double : C'est à dire si j'ai le même numéro de série d'un équipement (colonne B) dans 2 lignes la macro supprimera la 2 eme ligne qui a une date de fin (Colonne H) moins que l'autre.

j'ai mis en jointure un exemple.

Merci par avance pour votre aide!

[Pellouaille]

Hello amouna123456,

Plusieurs solutions en utilisant des fonctions Excel plus élaboré
Avec des choses simple, via VBA:

1 - On trie les dates de la plus grandes à la plus petite
2 - On trie 'input serial' (du plus grand au plus petit, ou l'inverse... Pas important)

Exemple trie d'une plage:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("J1:L20").Sort Range("J1"), xlAscending, Range("L1"), , xlAscending

3 - On boucler:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
i = 1
 
Range("B"& i). select
 
' Boucle tant que pas vide
Do While Not (IsEmpty(ActiveCell))  
    IF Range("B"& i) = Range("B"& i + 1) THEN
        Rows(i + 1).EntireRow.Delete Shift:=xlUp
    ELSE
        i = i + 1
    END IF
    Range("B"& i). select
Loop

Code non testé car je n'ai pas Excel sur mon PC perso mais avec quelque chose comme cela vous ne devriez pas être loin de la vérité (enfin, d'une vérité) ;-)

Cordialement,

Pellouaille

[kiki29]

Salam, de la lecture : La gestion des doublons dans Excel

[amouna123456]

Bonjour Pellouaille,

Ce code marche bien, mais il ne prend pas en considération les dates.
il supprime toutes les lignes en double et il garde une date ancienne et supprime la récente (des fois l'inverse) même si j'ai trié au début avant d’exécuter la macro.
est ce qu'il y'a une manière de garder juste les dates les plus récentes de la colonne H?

Merci beaucoup

Cordialement

[Pellouaille]

Hello amouna123456,

Oui en effet dans le code il manque les deux premières lignes ci-dessous:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Range("A2:H11").Sort Range("A2"), xlDescending, Range("H2"), , xlDescending
Range("A2:H11").Sort Range("A2"), xlAscending, Range("B2"), , xlAscending
 
i = 1
 
Range("B" & i).Select
 
' Boucle tant que pas vide
Do While Not (IsEmpty(ActiveCell))
    If Range("B" & i) = Range("B" & i + 1) Then
        Rows(i + 1).EntireRow.Delete Shift:=xlUp
    Else
        i = i + 1
    End If
    Range("B" & i).Select
Loop

Il faut ajuster le 'Range' pour correspondre à la votre.

Tenez moi au courant si vous avez d'autres questions.

EDIT:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Dim lastrow As String
lastrow = Cells(Rows.Count, "A").End(xlUp).Row

Après cela vous pouvez continuer avec:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Range("A2:H" & lastrow).Sort Range("A2"), xlDescending, Range("H2"), , xlDescending
Range("A2:H" & lastrow).Sort Range("A2"), xlAscending, Range("B2"), , xlAscending

Attention car H n'est sans doute pas votre dernière colonne... code à ajuster si besoin...

Cordialement,

Pellouaille

[amouna123456]

Merci beaucoup ! ça marche très bien .

au niveau de la colonne H, est ce qu'il y'a la possibilité de laisser le nombre de ligne illimité et ne pas la fixer?

j'ai mis 1000 au lieu de 11 mais je peux avoir plus...

Merci encore pour vos solutions qui me facilite la vie !

[Pellouaille]

Hello amouna123456,

C'est ce que fait le code que j'ai ajouté dans l'EDIT de mon précédant message.

Dès le début de la macro il faut ajouter:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Dim lastrow As String
lastrow = Cells(Rows.Count, "A").End(xlUp).Row

Et ensuite il faut remplacer les deux lignes:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Range("A2:H11").Sort Range("A2"), xlDescending, Range("H2"), , xlDescending
Range("A2:H11").Sort Range("A2"), xlAscending, Range("B2"), , xlAscending

par:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Range("A2:H" & lastrow).Sort Range("A2"), xlDescending, Range("H2"), , xlDescending
Range("A2:H" & lastrow).Sort Range("A2"), xlAscending, Range("B2"), , xlAscending

Cordialement,

Pellouaille

[amouna123456]

je viens de tester ce code sur un cas réel, il supprime les dates récentes

Vous pouvez vérifier svp

Désolée pour ce dérangement.

[Pellouaille]

Hello amouna123456,

Pouvez-vous partager un format .xlsx de vos données s'il vous plait ? (enlevez les infos si confidentielles, juste besoin des 10 premières lignes pour checker le format des données et avoir quelque chose de concret).

Cordialement,

Pellouaille

[Pellouaille]

Hello amouna123456,

Le format des données colonne H n'est pas au bon format (texte au lieu de date).

Il est donc impossible de les filtrer correctement.

Il faut changer le format de la colonne H:

1 - Séléctionner la colonne H
2 - Onglet 'Données', 'Convertir' -> 2 fois 'suivant' et sélectionner Date + le bon format dans la liste déroulante.
3 - Utilisez le code ci-dessous:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Dim lastrow As String
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
 
ActiveWorkbook.Worksheets("SNIF").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("SNIF").AutoFilter.Sort.SortFields.Add Key:=Range( _
    "H1:H" & lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("SNIF").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
ActiveWorkbook.Worksheets("SNIF").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("SNIF").AutoFilter.Sort.SortFields.Add Key:=Range( _
    "B1:B" & lastrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("SNIF").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
 
i = 1
 
Range("B" & i).Select
 
' Boucle tant que pas vide
Do While Not (IsEmpty(ActiveCell))
    If Range("B" & i) = Range("B" & i + 1) Then
        Rows(i + 1).EntireRow.Delete Shift:=xlUp
    Else
        i = i + 1
    End If
    Range("B" & i).Select
Loop

Cordialement,

Pellouaille

[amouna123456]

il fonctionne bien maintenant, il reste une petite modification à rajouter.
si une ligne est en double : la première ligne avec des *** et la 2eme ligne avec des informations (une date au lieu des ***)
la ligne à supprimer est la ligne avec les étoiles.
voici un exemple :

Merci beaucoup !

[Pellouaille]

Il est possible de rajouter un teste qui check, lorsque l'on a trouvé un doublon, si H de la première ligne est '***'. Si c'est le cas, je la supprime quelque soit la valeur 'H' de la ligne suivante:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
If Range("H" & i) = "***" Then
    Rows(i).EntireRow.Delete Shift:=xlUp
ELSE
    Rows(i + 1).EntireRow.Delete Shift:=xlUp
End if

Code à imbriquer au bon endroit dans le précédent code déjà partagé.

Cordialement,

Pellouaille

[amouna123456]

Je viens de tester, il a gardé la ligne avec les étoiles

même pour ces lignes aussi , il prend la ligne avec les étoiles alors que le mieux pour moi et de garder la ligne avec plus d'infotmrations.

je suis désolée pour ce dérangement

Merci beaucoup

[Pellouaille]

La boucle ci-dessous fonctionne de mon côté:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
' Boucle tant que pas vide
Do While Not (IsEmpty(ActiveCell))
    If Range("B" & i) = Range("B" & i + 1) Then
        If Range("H" & i) = "***" Then
            Rows(i).EntireRow.Delete Shift:=xlUp
        Else
            Rows(i + 1).EntireRow.Delete Shift:=xlUp
        End If
Else
        i = i + 1
    End If
    Range("B" & i).Select
Loop

Peut être la valeur des étoiles '***' en H ... Essayer de copier la valeur d'un cellule étoile et de remplacer "***" dans le code VBA.

Essayez d'y aller ligne par ligne (F8) pour voir à quel moment le code ne fait pas ce que vous attendez de celui-ci.

Cordialement,

Pellouaille

EDIT: Le printscreen semble bon au niveau de la gestion des dates (pas d'étoile en 'H')... Peut être deux valeurs différentes dans la colonne 'B'? Un espace à la fin d'un des deux code colonne 'B'?

[amouna123456]

ça marche

et si j'ai 3 ou 4 lignes répétées et je veux garder une seule avec la date la plus récente?


pour le screen : j'ai plusieurs cas que je dois vérifier avant d'appliquer la Macro. je fais un test sur plusieurs fichiers et je vérifie au fur et à mesure....

c'est pour cette raison je pose beaucoup de question

Merci

[Pellouaille]

et si j'ai 3 ou 4 lignes répétées et je veux garder une seule avec la date la plus récente?

Si il y a 3, 4 ou x même lignes, la macro va gérer directement ce cas là et garder la ligne avec la date la plus récente.

pour le screen : j'ai plusieurs cas que je dois vérifier avant d'appliquer la Macro. je fais un test sur plusieurs fichiers et je vérifie au fur et à mesure....

Là c'est autre chose...

Comment identifier les cas à vérifier? En suivant certains 'Input Serial'? Si oui, combien?

On peut faire ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Do While Not (IsEmpty(ActiveCell))
If Range("B" & i) = "CODE_1" Or Range("B" & i) = "CODE_2" Or .... Saisir ici tous les codes à exclure .... THEN
Else
    If Range("B" & i) = Range("B" & i + 1) Then
        If Range("H" & i) = "***" Then
            Rows(i).EntireRow.Delete Shift:=xlUp
        Else
            Rows(i + 1).EntireRow.Delete Shift:=xlUp
        End If
    Else
        i = i + 1
    End If
End If
    Range("B" & i).Select
Loop

Par contre if faudra passer manuellement et supprimer les lignes restantes.

Cordialement,

Pellouaille

[amouna123456]

Bonjour Pellouaille,

pas au niveau des input serial mais au niveau des informations qui se trouvent dans les autres colonnes.

jusqu'à maintenant tout me parait bien, juste dans le cas des 4 lignes (comme l'exemple que je vous ai donné avant) il a supprimé les lignes avec les dates et il a gardé une ligne avec les étoiles.


j'ai mis un fichier en jointure, si vous appliquez la macro vous allez voir que la ligne qui va garder est la ligne avec les étoiles

Merciii

[Pellouaille]

Hello amouna123456,

Le code fonctionne avec votre exemple (attention au format des dates column H comme signalé précédement -> il faut convertir les données en date pour les ranger correctement)

Ajoutez ça au début du code pour gérer automatiquement le format de la colonne H:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
    Columns("H:H").Select
    Selection.TextToColumns Destination:=Range("H1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 3), TrailingMinusNumbers:=True

Cela donne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Macro1()
 
Dim lastrow As String
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
 
Columns("H:H").Select
    Selection.TextToColumns Destination:=Range("H1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 3), TrailingMinusNumbers:=True
 
ActiveWorkbook.Worksheets("SNIF").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("SNIF").AutoFilter.Sort.SortFields.Add Key:=Range( _
    "H1:H" & lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("SNIF").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
ActiveWorkbook.Worksheets("SNIF").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("SNIF").AutoFilter.Sort.SortFields.Add Key:=Range( _
    "B1:B" & lastrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("SNIF").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
 
i = 1
 
Range("B" & i).Select
 
' Boucle tant que pas vide
Do While Not (IsEmpty(ActiveCell))
    If Range("B" & i) = Range("B" & i + 1) Then
        If Range("H" & i) = "***" Then
            Rows(i).EntireRow.Delete Shift:=xlUp
        Else
            Rows(i + 1).EntireRow.Delete Shift:=xlUp
        End If
Else
        i = i + 1
    End If
    Range("B" & i).Select
Loop
 
End Sub

Si vous voulez empêcher la macro d'effectuer la suppression pour certaines valeurs, utilisez la fonction vu précédement et ajustez la:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Range("COLONNE QUE VOUS VOULEZ VERIFIER" & i) = "VALEUR A VERIFIER" Or .... Saisir ici tous les codes à exclure suivant le même schéma .... THEN

Cordialement,

Pellouaille

[amouna123456]

ça marche enfin !

Merci infiniment pour votre aide et votre assistance

Bonne journée

[Pellouaille]

Hello amouna123456,

Plus qu'à cocher si tout est bon pour vous.

Bonne fin de journée !

Cordialement,

Pellouaille