Boucle vba qui marche pas !!
koax
-
ccm81 Messages postés 11033 Statut Membre -
ccm81 Messages postés 11033 Statut Membre -
Bonjour,
j'essaye de faire macro pour effacer les doublon d'une colonne
voila mon essai
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...
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
-
-
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 -
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
