VBA: Comparer plusieurs lignes entre elles (Eviter les doublons)
Résolu
Losiu
-
Losiu -
Losiu -
Bonjour à tous,
Etant novice en VBA (j'essaie de bricoler quelques trucs ensembles juste), je me permet, une nouvelle fois, de faire appel à vous.
J'ai un tableau de données (plusieurs critères qui vont de B à W inclus).
Ce tableau est amené à évoluer régulièrement.
Les données seront ajoutées ligne par ligne à la suite.
Mon problème est :
- Il sera fréquent de trouver des doublons dans ce tableau.
J'aimerais si possible supprimer les doublons, c'est à dire la ligne de donnée qui existe déjà.
Je pensais faire ceci :
-----------------------------------------------------------------------------------------------
W = 7
While Cells(W, 2).Value <> ""
W = W + 1
Wend
'W représente désormais la dernière ligne du tableau
B = 7 'ligne à vérifier
N = 8 'ligne en cours de vérification
While B > W
' c'est maintenant qu'il y a surement des erreurs. Je voulais faire un truc du genre :
If cells(N,2).value=Cells(B,2).value then
if cells(N,3).value=cells(B,3).value then
if ...N,4 ..............B, 4 then
if ....
cells(N,2).value=""
cells(N,3).value=""
cells(N,4).value=""
...
End if
End if
End if
End if....
B=B+1
Wend
-----------------------------------------------------------------------------------------------
J'ai pas trop d'idée et je ne trouve pas sur internet comment avancer...
En vous remerciant de vos réponse.
Cordialement
Etant novice en VBA (j'essaie de bricoler quelques trucs ensembles juste), je me permet, une nouvelle fois, de faire appel à vous.
J'ai un tableau de données (plusieurs critères qui vont de B à W inclus).
Ce tableau est amené à évoluer régulièrement.
Les données seront ajoutées ligne par ligne à la suite.
Mon problème est :
- Il sera fréquent de trouver des doublons dans ce tableau.
J'aimerais si possible supprimer les doublons, c'est à dire la ligne de donnée qui existe déjà.
Je pensais faire ceci :
-----------------------------------------------------------------------------------------------
W = 7
While Cells(W, 2).Value <> ""
W = W + 1
Wend
'W représente désormais la dernière ligne du tableau
B = 7 'ligne à vérifier
N = 8 'ligne en cours de vérification
While B > W
' c'est maintenant qu'il y a surement des erreurs. Je voulais faire un truc du genre :
If cells(N,2).value=Cells(B,2).value then
if cells(N,3).value=cells(B,3).value then
if ...N,4 ..............B, 4 then
if ....
cells(N,2).value=""
cells(N,3).value=""
cells(N,4).value=""
...
End if
End if
End if
End if....
B=B+1
Wend
-----------------------------------------------------------------------------------------------
J'ai pas trop d'idée et je ne trouve pas sur internet comment avancer...
En vous remerciant de vos réponse.
Cordialement
A voir également:
- VBA: Comparer plusieurs lignes entre elles (Eviter les doublons)
- Excel compter cellule couleur sans vba - Guide
- Incompatibilité de type vba ✓ - Forum VB / VBA
- Erreur 13 incompatibilité de type VBA excel ✓ - Forum Excel
- Mkdir vba ✓ - Forum VB / VBA
- Dépassement de capacité vba ✓ - Forum Excel
4 réponses
Salut,
Deja pour
Quand tu auras 1000 lignes ta macro va tourner déjà 15-20secondes pour ça
Pourquoi ne pas avoir un cellule dédié pour compter ?
En VBA en faisant incrémenter a chaque saisi, décrementer a chaque suppression.
Ou avec une formule simplement avec un nb.si
Je faisais pareil avant et j'ai vite abandonné vu la lenteur (au bout de 400 lignes)
Deja pour
W = 7 While Cells(W, 2).Value <> "" W = W + 1 Wend 'W représente désormais la dernière ligne du tableau
Quand tu auras 1000 lignes ta macro va tourner déjà 15-20secondes pour ça
Pourquoi ne pas avoir un cellule dédié pour compter ?
En VBA en faisant incrémenter a chaque saisi, décrementer a chaque suppression.
Ou avec une formule simplement avec un nb.si
Je faisais pareil avant et j'ai vite abandonné vu la lenteur (au bout de 400 lignes)
Et pour le si et la suppression tu peux utiliser ca,
A plus
If Cells(N, 2).Value = Cells(B, 2).Value And Cells(N, 3).Value = Cells(B, 3).Value And Cells(N, 4).Value = Cells(B, 4).Value And Cells(N, 5).Value = Cells(B, 5).Value And Cells(N, 6).Value = Cells(B, 6).Value And Cells(N, 7).Value = Cells(B, 7).Value Then Cells(N, 1).EntireRow.Delete End If
A plus
Bonsoir l fil, bonsoir le forum,
Je plussoie complètement Unombre ! Perte de temps inutile de boucler pour connaître la dernière ligne éditée d'une colonne. Un des codes le plus utilisé est (par exemple en stockant cette dernière ligne dans la variable DL) :
Je te propose une solution qui utilise une variable tableau (que j'ai nommée TV dans l'exemple) qui équivaut à tes cellules. Cela accélère énormément l'exécution du code. Nom de l'onglet à adapter :
Je plussoie complètement Unombre ! Perte de temps inutile de boucler pour connaître la dernière ligne éditée d'une colonne. Un des codes le plus utilisé est (par exemple en stockant cette dernière ligne dans la variable DL) :
DL = Worksheets("Feuil1").Cells(Application.Rows.Count, "B").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne B de l'onglet Feuil1
Je te propose une solution qui utilise une variable tableau (que j'ai nommée TV dans l'exemple) qui équivaut à tes cellules. Cela accélère énormément l'exécution du code. Nom de l'onglet à adapter :
Sub Macro1() Dim O As Worksheet 'déclare la variable O (Onglet) Dim DL As Long 'déclare la variable DL (Dernière Ligne) Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs) Dim PE As Range 'déclare la variable PE (Plage à Effacer) Dim I1 As Long 'déclare la variable I1 (Incrément 1) Dim I2 As Long 'déclare la variable I2 (Incrément 2) Set O = Worksheets("Feuil1") 'définit l'onglet O (à adapter à ton cas) DL = O.Cells(Application.Rows.Count, "B").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne B de l'onglet O TV = O.Range(O.Cells(7, "B"), O.Cells(DL, "W")) 'définit le tableau des valeurs TV Set PE = O.Range("A1") 'initialise la plage à effacer PE For I1 = 1 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I1 du tableau des valeurs TV For I2 = 1 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I2 du tableau des valeurs TV If I1 = I2 Then GoTo suite 'si I1 est égale à I2, va à l'étiquette "suite" 'définit la valeur VL1 de la ligne I1 (toutes les données de la lignes séparée par un espace) VL1 = Join(Application.Index(TV, I1), " ") 'définit la valeur VL2 de la ligne I2 (toutes les données de la lignes séparée par un espace) VL2 = Join(Application.Index(TV, I2), " ") 'si VL2 est égale à VL1 redéfinit la plage à effacer PE If VL2 = VL1 Then Set PE = IIf(PE.Cells.Count = 1, O.Rows(I2 + 6), Application.Union(PE, O.Rows(I2 + 6))) suite: 'étiquette Next I2 'prochaine ligne de la boucle 2 Next I1 'prochaine ligne de la boucle 1 PE.Delete 'supprime la plage PL End Sub
Bonjour à tous,
Je vous remercie de vos réponses à tous.
Je trouve la 2ème solution de Unombre très facile à comprendre (dommage qu'elle soit à proscrire apparemment).
Merci pour le code ThauTheme je le réutiliserai certainement plus tard.
J'ai trouvé plus simple ce matin (j'ai pas pensé à regarder le forum avant de commencer oups ^^).
Enregistrer une macro en utilisant directement la fonction "Supprimer les doublons" dans l'onglet données..
Plus rapide, plus simple je pense.
Désolé de ne pas y avoir pensé plus tôt..
Encore merci pour votre aide c'est vraiment sympa !!!
@+
Je vous remercie de vos réponses à tous.
Je trouve la 2ème solution de Unombre très facile à comprendre (dommage qu'elle soit à proscrire apparemment).
Merci pour le code ThauTheme je le réutiliserai certainement plus tard.
J'ai trouvé plus simple ce matin (j'ai pas pensé à regarder le forum avant de commencer oups ^^).
Enregistrer une macro en utilisant directement la fonction "Supprimer les doublons" dans l'onglet données..
Plus rapide, plus simple je pense.
Désolé de ne pas y avoir pensé plus tôt..
Encore merci pour votre aide c'est vraiment sympa !!!
@+