Boucle vba qui marche pas !!

Bonjour,

j'essaye de faire macro pour effacer les doublon d'une colonne

voila mon essai

Sub Bouton2_Cliquer()
Dim i As Long
Application.ScreenUpdating = False
For i = Range("b5000").End(xlUp).Row To 4 Step -1
If Cells(i, 2).Value <> 0 Then Cells(i, 3) = Cells(i, 2)
Next i
Application.ScreenUpdating = True
Dim j As Integer
Dim c As Integer
c = 3
Application.ScreenUpdating = False
For j = 4 To 200
If Cells(j, 3).Value <> "" Then Cells(c + 1, 4).Value = Cells(j, 3).Value
c = c + 1
Next j
Application.ScreenUpdating = True
End Sub


j'ai essayer dans un premier temps de supprimer les doublons
puis supprimer les cellules vides qui sortent après la première boucles

j'ai simuler chaque boucle avec un exemple simple et ça marche par contre sur mon tableau de données la deuxième partie pour les cellules vides ne marche pas...

3 réponses

  1. Bonjour à tous

    Pour aller un peu plus vite

    Const co = "A"
    Const lideb = 2

    Sub OK()
    Dim li As Long, lifin As Long
    Dim dico As Object, cle As String
    Application.ScreenUpdating = False
    lifin = Cells(Rows.Count, co).End(xlUp).Row
    Set dico = CreateObject("scripting.dictionary")
    For li = lifin To lideb Step -1
    cle = Cells(li, co)
    If dico.exists(cle) Then
    Rows(li).Delete
    Else
    dico.Add cle, 1
    End If
    Next li
    Application.ScreenUpdating = True
    End Sub

    Cdlmnt
    1. Bonjour,

      pour supprimer les doublons de la colonne A essayez ceci :

      Dim I As Variant, j As Variant
      
      For I = 4 To Range("A" & Rows.Count).End(xlUp).Row
          For j = I + 1 To Range("A" & Rows.Count).End(xlUp).Row
              Do While Cells(I, 1).Value = Cells(j, 1).Value
                  Cells(j, 1).EntireRow.Delete 'supp la ligne entière en cas de doublon, à adapter si cellule a supp à la place de ligne
              Loop
          Next j
      Next I