Boucle vba qui marche pas !!
koax
-
ccm81 Messages postés 10909 Date d'inscription Statut Membre Dernière intervention -
ccm81 Messages postés 10909 Date d'inscription Statut Membre Dernière intervention -
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...
A voir également:
- Boucle vba qui marche pas !!
- Excel compter cellule couleur sans vba - Guide
- Pc qui s'allume et s'éteint en boucle - Forum Virus
- L'indice n'appartient pas à la sélection vba ✓ - Forum Programmation
- Vba attendre 1 seconde ✓ - Forum VB / VBA
- Xiaomi s'éteint tout seul et se rallume en boucle - Forum Xiaomi
3 réponses
Bonjour,
pour supprimer les doublons de la colonne A essayez ceci :
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
Cdlmnt
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