Menu

[VB.Excel] Supprimer & compter les lignes en double [Résolu]

Messages postés
25
Date d'inscription
dimanche 27 mai 2018
Dernière intervention
22 mars 2019
- - Dernière réponse : ProMed1
Messages postés
25
Date d'inscription
dimanche 27 mai 2018
Dernière intervention
22 mars 2019
- 11 mars 2019 à 21:21
Bonjour à tous,

j'ai un tableau excel, mon bute est de supprimer toutes les lignes en double et de les compter sur la colonne "G". (voir capture ci-dessous)

j'explique un peut le tableau, prenant l'exemple de la ligne 2:

la cellule "B2" est paramétrait (lier) si vous voulez par la cellule "A2".
de même la cellule "D2" est paramétrait par la cellule "C2".
de même également les cellules "A2", "B2", "C2" et "D2" sont paramétrait par les cellules "E2" et "F2".

Pour moi les lignes 6, 7, 12.13 et 14 sont en double.

j'ai essayer de trouver une manip via Excel et même par les requêtes Access mais en vain, pouvez vous m'aider svp.

merci d'avance.


Afficher la suite 

Votre réponse

1 réponse

Messages postés
7580
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
24 mars 2019
451
0
Merci
bonjour, pourquoi les lignes 6, 7, 12.13 et 14 sont-elles en double?
pourquoi veux-tu les supprimer? veux-tu faire cela une seule fois?
ProMed1
Messages postés
25
Date d'inscription
dimanche 27 mai 2018
Dernière intervention
22 mars 2019
-
bonjour yg_be,

si j'ai bien compris, ci-dessous le code.
il me reste qu'a mentionner sur la colonne "G" du (lig1) combien de fois cette ligne a été trouvé.
1000 merci pour votre code main.

Option Explicit

Sub SetC()
Dim x As Long
Dim lig1 As Long, lig2 As Long
For lig1 = 2 To 17
x = 0
For lig2 = lig1 + 1 To 17
If Cells(lig1, 1).Value = Cells(lig2, 1).Value And Cells(lig1, 6).Value = Cells(lig2, 6).Value _
And Cells(lig1, 3).Value = Cells(lig2, 3).Value _
And Cells(lig1, 5).Value = Cells(lig2, 5).Value _
And ((Cells(lig1, 2).Value = Cells(lig2, 4).Value And Cells(lig1, 4) = Cells(lig2, 2)) Or _
(Cells(lig1, 2).Value = Cells(lig2, 2).Value And Cells(lig1, 4) = Cells(lig2, 4))) _
Then
Cells(lig2, 7).Value = "Doublon"
Cells(lig2, 8).Value = x + 1
x = x + 1
End If
Next lig2
Next lig1
MsgBox "Traitement terminé"
End Sub
yg_be
Messages postés
7580
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
24 mars 2019
451 > ProMed1
Messages postés
25
Date d'inscription
dimanche 27 mai 2018
Dernière intervention
22 mars 2019
-
peux-tu utiliser "basic" comme langage quand tu partages du code vba?
suggestion:
Sub SetC()
Dim x As Long
Dim lig1 As Long, lig2 As Long
For lig1 = 2 To 17
    x = 0
    For lig2 = lig1 + 1 To 17
        If Cells(lig1, 1).Value = Cells(lig2, 1).Value And Cells(lig1, 6).Value = Cells(lig2, 6).Value _
            And Cells(lig1, 3).Value = Cells(lig2, 3).Value _
            And Cells(lig1, 5).Value = Cells(lig2, 5).Value _
            And ((Cells(lig1, 2).Value = Cells(lig2, 4).Value And Cells(lig1, 4) = Cells(lig2, 2)) Or _
            (Cells(lig1, 2).Value = Cells(lig2, 2).Value And Cells(lig1, 4) = Cells(lig2, 4))) _
        Then
            Cells(lig2, 7).Value = "Doublon"
            Cells(lig2, 8).Value = x
            x = x + 1
            Cells(lig1, 7).Value = x
        End If
    Next lig2
Next lig1
MsgBox "Traitement terminé"
End Sub
ProMed1
Messages postés
25
Date d'inscription
dimanche 27 mai 2018
Dernière intervention
22 mars 2019
-
oui, bien reçu.
ProMed1
Messages postés
25
Date d'inscription
dimanche 27 mai 2018
Dernière intervention
22 mars 2019
-
bonjour yg_be,

enfin réussie, la macro roule tait bien.
sur la colonne "I" j'ai ajouté une instruction qui compte les doublons de la (lig1).
trais ouverts pour toutes vos suggestions.

<code basic>
Option Explicit

Sub SetC()
Dim x As Long
Dim lig1 As Long, lig2 As Long


For lig1 = 2 To 17
x = 0
For lig2 = lig1 + 1 To 17
If Cells(lig1, 1).Value = Cells(lig2, 1).Value And Cells(lig1, 6).Value = Cells(lig2, 6).Value _
And Cells(lig1, 3).Value = Cells(lig2, 3).Value And Cells(lig1, 5).Value = Cells(lig2, 5).Value _
And ((Cells(lig1, 2).Value = Cells(lig2, 4).Value And Cells(lig1, 4) = Cells(lig2, 2)) _
Or (Cells(lig1, 2).Value = Cells(lig2, 2).Value _
And Cells(lig1, 4) = Cells(lig2, 4))) Then
Cells(lig2, 7).Value = "Doublon"
Cells(lig2, 8).Value = x + 1


Cells(lig1, 9).Value = (Cells(lig2, 8).Value + 1)


x = x + 1
End If
Next lig2
Next lig1

MsgBox "Traitement terminé"

End Sub</code>
ProMed1
Messages postés
25
Date d'inscription
dimanche 27 mai 2018
Dernière intervention
22 mars 2019
-
Option Explicit


Sub SetC()
Dim x As Long
Dim lig1 As Long, lig2 As Long


For lig1 = 2 To 17
x = 0
For lig2 = lig1 + 1 To 17
If Cells(lig1, 1).Value = Cells(lig2, 1).Value And Cells(lig1, 6).Value = Cells(lig2, 6).Value _
And Cells(lig1, 3).Value = Cells(lig2, 3).Value And Cells(lig1, 5).Value = Cells(lig2, 5).Value _
And ((Cells(lig1, 2).Value = Cells(lig2, 4).Value And Cells(lig1, 4) = Cells(lig2, 2)) _
Or (Cells(lig1, 2).Value = Cells(lig2, 2).Value _
And Cells(lig1, 4) = Cells(lig2, 4))) Then
Cells(lig2, 7).Value = "Doublon"
Cells(lig2, 8).Value = x + 1


Cells(lig1, 9).Value = (Cells(lig2, 8).Value + 1)


x = x + 1
End If
Next lig2
Next lig1

MsgBox "Traitement terminé"

End Sub
Commenter la réponse de yg_be