suppression des lignes qui se répètent

Bonjour,

Je voudrais créer une macro qui permette de supprimer automatiquement les mots (et la ligne entière qui en découle) qui se répettent plusieurs fois dans une même colonne.

J'ai pensé à cet algorithme détaillé, mais je ne réussis pas à le faire fonctionner sous Excel, pourriez-vous m'aider s'il vous plaît? :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20

Dim i As Integer Dim j As Integer Dim chaine1 As String Dim chaine2 As String   i = 1 do   J = i Chaine1 = (A, i). Select, do J = J+1 ''rechercher selection : quand mot = selection, sélectionner la ligne entière puis supprimer Chaine2 = (A, j). Select, If Chaine2=chaine1 Then Rows.Select selection.delete while J < 81   While I < 82

---

J'ai une erreur de syntaxe sur : Chaine1 = (A , j). Select...
Pourtant j'ai bien défini le "chaine1" en string, donc le contenu de la cellule devrait pouvoir être affecté à "chaine"...

Merci d'Avance pour votre aide

bonjour linooo

c'est difficile de faire un code en aveugle. et je ne comprends pas trop ton code

je vais neanmoins essayé, Controle d'égalité sur la colonne A, j'estime que le fichier est deja trié

Deja une boucle de suppression de ligne ne va pas de 1 à X mais le contraire car quand tu supprime la ligne 3, la 4 devenant 3 ne sera pas traitée

Code:

---

1 2 3 4 5 6 7

sub sup_lignes() dim i as long for i = Range("A65536").end(xlup).row to 2 step -1 ' Je pars de la fin vers le haut if Range("A" & i).value = Range("A" & (i-1)).value then range("A" & i).entirerow.delete next i end sub

---

bonne soirée

Bonjour wilfried_42,

Je te remercie pour ton programme qui marche parfaitement.
Le seul soucis, c'est que je doive faire un tri juste avant.

Ne serait-il pas possible de rajouter une variable, afin de comparer les cellules lorsqu'elles ne sont pas triées?

J'ai pensé à un programme qui permette de supprimer le contenu des cellules sans supprimer les lignes (elles seront supprimer qu'à la fin).

Par contre, je pense avoir un souci avec ma boucle, car cela m'affiche le message d'erreur suivant : "while sans wend". Je fait très rarement de VBA, je connais mal l'architecture des boucles...

Merci d'avance,

(Mon code ci-dessous)

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

Dim i As Integer Dim j As Integer Dim o As Integer       i = 1 Do j = i Do j = j + 1 If Range("A" & i).Value = Range("A" & j).Value Then Range("A" & j).Delete While j < 81   While i < 82   For o = Cells(82, 1).End(xlUp).Row To 1 Step -1 If Cells(o, 1).Value = "" Then Cells(o, 1).EntireRow.Delete Next o     End Sub

---

re:

une boucle

Code:

---

1 2 3 4 5 6

While i<82 . . . . Wend

---

une autre

Code:

---

1 2 3 4 5 6 7

Do while i<82 . . . . . loop

---

une autre

Code:

---

1 2 3 4 5 6 7

Do . . . . . Loop Until i = 83

---

Bonne journée

bonjour

Tu peux tester cette procédure pour supprimer les doublons dans la plage A1:A10, sans appliquer de tri préalable.

Code:

---

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

Option Explicit Option Base 1   Sub SupprimeDoublons_A1A10() Dim Plage As Range, Cell As Range Dim Un As New Collection Dim Tableau() As Integer Dim x As Integer     Set Plage = Worksheets("Feuil1").Range("A1:A10")   For Each Cell In Plage On Error Resume Next 'création d'une collection unique (sans doublons) Un.Add Cell, CStr(Cell)   'Une erreur survient si l'element existe dans la collection 'La procédure enregistre le numéro de ligne correspondant 'dans un tableau. If Err.Number <> 0 Then x = x + 1 ReDim Preserve Tableau(x) Tableau(x) = Cell.Row End If Next Cell     If x = 0 Then Exit Sub   Application.ScreenUpdating = False   'boucle sur le tableau pour supprimer les lignes correspondant 'aux doublons. For x = UBound(Tableau) To LBound(Tableau) Step -1 Worksheets("Feuil1").Rows(Tableau(x)).EntireRow.Delete Next x   Application.ScreenUpdating = True End Sub

---

michel

Merci beaucoup wilfried_42 pour l'architecture des boucles, j'ai pu faire marcher mon programme :)

Sinon, je te remercie SilkyRoad, je vais aller tester ton code, je pense qu'il est plus efficace que le mien qui prend un peu de temps à s'exécuter...

Merci à tous les deux, bonne journée et à bientôt