VBA Excel suppression des doublons
tito23
Messages postés
305
Date d'inscription
Statut
Membre
Dernière intervention
-
tito23 Messages postés 305 Date d'inscription Statut Membre Dernière intervention -
tito23 Messages postés 305 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
Je voudrais chercher toutes les occurrences doublons d'un colonne dans un autre colonne(ici E et F) s' il y a un doublon alors il faudra changer la cellule de la colonne 'E' en "doublon", idéalement supprimer toutes les cellules de la même ligne du doublon jusqu'à la cellule se trouvant sur colonne 'E'.
J'ai testé ce code mais ça marche pas!!
Et merci d'avance de votre aide.
Sub test()
Dim i As Double
Dim j As Double
i = 1
j = 1
With Worksheets("filtre") ' On parcourt la colonne E
Do While (.Range("E" & i) <> "fin")
'on parcourt la colonne F
Do While (.Range("F" & j) <> "fin")
If (.Range("E" & i) = .Range("F" & j)) Then
.Range("E" & i) = "doublon"
Exit Do
End If
j = j + 1
Loop
i = i + 1
Loop
' Ici on teste la cellule actuelle :
End With
End Sub
Je voudrais chercher toutes les occurrences doublons d'un colonne dans un autre colonne(ici E et F) s' il y a un doublon alors il faudra changer la cellule de la colonne 'E' en "doublon", idéalement supprimer toutes les cellules de la même ligne du doublon jusqu'à la cellule se trouvant sur colonne 'E'.
J'ai testé ce code mais ça marche pas!!
Et merci d'avance de votre aide.
Sub test()
Dim i As Double
Dim j As Double
i = 1
j = 1
With Worksheets("filtre") ' On parcourt la colonne E
Do While (.Range("E" & i) <> "fin")
'on parcourt la colonne F
Do While (.Range("F" & j) <> "fin")
If (.Range("E" & i) = .Range("F" & j)) Then
.Range("E" & i) = "doublon"
Exit Do
End If
j = j + 1
Loop
i = i + 1
Loop
' Ici on teste la cellule actuelle :
End With
End Sub
A voir également:
- Supprimer les doublons vba
- Supprimer rond bleu whatsapp - Guide
- Supprimer page word - Guide
- Supprimer les doublons excel - Guide
- Doublons photos - Guide
- Supprimer pub youtube - Accueil - Streaming
5 réponses
Bonjour
idéalement supprimer toutes les cellules de la même ligne du doublon se trouvant sur la colonne 'E' jusqu'à la colonne 'E'.
Oui ????
idéalement supprimer toutes les cellules de la même ligne du doublon se trouvant sur la colonne 'E' jusqu'à la colonne 'E'.
Oui ????
tito23
Messages postés
305
Date d'inscription
Statut
Membre
Dernière intervention
4
c à dire jusqu'à la cellule se trouvant sur la colonne E
Bonjour,
J'ai trouvé une solution.Mais très lourde vu que j'ai 600000 enregistrement dans mon fichier excel.
S'il y a une amélioration, je suis preneur (effectuer la suppression dans la première boucle)
Voici le code
J'ai trouvé une solution.Mais très lourde vu que j'ai 600000 enregistrement dans mon fichier excel.
S'il y a une amélioration, je suis preneur (effectuer la suppression dans la première boucle)
Voici le code
Sub Doublon()
Dim Plage_E As Range
Dim Plage_F As Range
Dim PlageTempo As Range
Dim Cel_E As Range
Dim Cel_F As Range
Dim I As Integer
'défini les plages
Set Plage_E = Range([E1], [E65536].End(xlUp))
Set Plage_F = Range([F1], [F65536].End(xlUp))
For Each Cel_E In Plage_E
'recherche la valeur de chaque cellule de la colonne E dans
'la colonne F
Set Cel_F = Plage_F.Find(Cel_E, , xlValues)
'si une occurence est trouvé dans la colonne F
'inscrit "Doublon" dans la cellule concernée de la colonne E
If Not Cel_F Is Nothing Then
Cel_E = "Doublon"
End If
Next Cel_E
'pour la suppression de cellules, il est préférable
'de parcourir la plage en partant de la fin
For I = Plage_E.Count To 1 Step -1
'si la cellule Ex contient le mot "Doublon"
'les cellules de Ax à Ex sont supprimées
If Plage_E(I) = "Doublon" Then
Range(Plage_E(I).Offset(0, -4), Plage_E(I)).Delete xlUp
End If
Next I
End Sub
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Tout compte fait en guise d"apéro
temps pour 1000 lignes 0,12 sec
nota: je ne sais pas si la fonction de tri "sort" fonctionne pour 600000 lignes !!!!
sinon, essaies avec cette instruction
Michel
Sub supp_doublons()
Dim Lig_E As Long, Lig_F As Long
Dim Dico_F As Object, Cptr As Long
Dim Ref 'a compléter
Dim T_out, Cptr_t As Long
Dim start As Single 'pour essai rapidité
start = Timer 'essai
'mémorise colonne F
Lig_F = Cells(Cells.Rows.Count, 6).End(xlUp).Row
Set Dico_F = CreateObject("scripting.dictionary")
For Cptr = 2 To Lig_F
Ref = Cells(Cptr, 6)
If Not Dico_F.exists(Ref) Then
Dico_F.Add Ref, Ref
End If
Next
'mémorise lignes en doublon dans E
Lig_E = Cells(Cells.Rows.Count, 5).End(xlUp).Row
ReDim T_out(0)
For Cptr = 2 To Lig_E
ReDim Preserve T_out(Cptr_t)
Ref = Cells(Cptr, 5)
If Dico_F.exists(Ref) Then
T_out(Cptr_t) = Cells(Cptr, 5).Row
Cptr_t = Cptr_t + 1
End If
Next
'supprime les valeurs en doublons colonne A à E
Application.ScreenUpdating = False
For Cptr = 0 To UBound(T_out) - 1
Range(Cells(T_out(Cptr), 1), Cells(T_out(Cptr), 5)).Clear
Next
' supprime les cellules vides dans la colonne E et trie
Range("E2:E" & Lig_E).Sort Range("E2")
MsgBox Timer - start & " secondes"
End Sub
temps pour 1000 lignes 0,12 sec
nota: je ne sais pas si la fonction de tri "sort" fonctionne pour 600000 lignes !!!!
sinon, essaies avec cette instruction
Range("E2:E" & Lig_E).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
au lieu de
Range("E2:E" & Lig_E).Sort Range("E2")
Michel
