Autres Suppression de doublons comportant 3 données en commun. Une seule ligne sera conservée

alain.pierrephie · 23 Janvier 2022

Bonjour au forum.
Je suis sur un truc qui m'avait paru simple mais je galère depuis maintenant 3 jours. Je fatigue et ai essayé plein de choses mais a chaque fois j'a une référence circulaire. Je joins un fichier de quelques lignes mais qui en a plus de 30 000. Voilà mon souci..

Supprimer les doublons qui possèdent un "ACHAT" en colonne "M" avec un "ATTENTE" en colonne "Q" et qui ont le même prix en "N" comme en cellule "N88" et cellule " N 192 ". A conserver le premier et faire disparaître les suivants. La même chose pour "N249" et "N283"
Je remercie celui ou ceux qui se pencheront sur mon problème
J'en profite pour souhaiter à vous tous une excellente année.
Alain

Robert · 23 Janvier 2022

Bonsoir Alain, bonsoir le forum,

Essaie le code commenté ci-dessous :

VB:

Option Explicit

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim PL As Integer 'déclare la variable PL (Première Ligne)
Dim MSG As String 'déclare la variable MSG (MeSsaGe)
Dim LAF() As Integer 'déclare la variable PAF (Ligne À Effacer)
Dim PLAF As Range 'déclare la variable PLAF (Plage des Lignes À Effacer)

Set O = Worksheets("Feuil1") 'définit l'onglet O
TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If TV(I, 13) = "" Or TV(I, 14) = "" Or TV(I, 17) = "" Then GoTo suite 'si une des 3 valeurs est vide, va à l'étiquette "suite"
    If TV(I, 13) = "x" Or TV(I, 14) = "x" Or TV(I, 17) = "x" Then GoTo suite 'si une des 3 valeurs vaut "x", va à l'étiquette "suite"
    If TV(I, 17) <> "attente" Then GoTo suite 'si la colonne Q est différente de "attente", va à l'étiquette "suite"
        D(TV(I, 13) & TV(I, 14) & TV(I, 17)) = "" 'alimente le dictionnaire D avec les 3 valeurs concaténées
suite: 'étiquette
Next I 'prochaine ligne de la boucle
TMP = D.keys 'alimente le tableau temporaire TMP avec la liste du dictionnaire D sans doublons (les clés)
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire TMP
    PL = 0 'initialise la première ligne PL
    For I = 2 To UBound(TV, 1) 'boucle 2 sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 13) & TV(I, 14) & TV(I, 17) = TMP(J) Then 'condition 1 : si les 3 valeurs concatenées sont égales à TMP(J)
            If PL <> 0 Then 'condition 2 : si la première ligne est différente de 0
                K = K + 1 'incrémente K
                ReDim Preserve LAF(1 To K) 'redimensionne le tableau des lignes à effacer LAF
                LAF(K) = I 'récupère la ligne I de la boucle 2 dans le tableau LAF
            Else 'sinon (si s'est la première ligne)
                PL = I 'définit la première ligne PL
                'définit le message MSG
                MSG = IIf(MSG = "", "Les premières Lignes sont :" & vbCrLf & I & " - " & TV(I, 13) & " - " & TV(I, 14) & " - " & TV(I, 17), _
                   MSG & vbCrLf & I & " - " & TV(I, 13) & " - " & TV(I, 14) & " - " & TV(I, 17))
            End If 'fin de la condition 2
        End If 'fin de la condition 1
    Next I 'prochaine ligne de la boucle 2
Next J 'prochain élément de la boucle 1
Set PLAF = O.Range("A1") 'initialise la plage PLAF
For I = LBound(LAF) To UBound(LAF) 'boucle sur toutes les lignes du tableau des ligne à effacer LAF
    Set PLAF = IIf(PLAF.Cells.Count = 1, O.Rows(LAF(I)), Application.Union(PLAF, O.Rows(LAF(I)))) 'redéfinit la plage PLAF
Next I 'prochaine ligne de la boucle
PLAF.Select 'sélectionne la plage PLAF
MsgBox MSG & vbCrLf & "Seuls les donblons sont sélectionnés !"
End Sub

Il ne supprime pas il sélectionne juste... Tu n'auras plus qu'à faire la combinaison de toucches [CTRL] + [-] pour supprimer mais je préfère te laisser vérifier d'abord.

alain.pierrephie · 23 Janvier 2022

Robert à dit:

Bonsoir Alain, bonsoir le forum,

Essaie le code commenté ci-dessous :

VB:

Option Explicit

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim PL As Integer 'déclare la variable PL (Première Ligne)
Dim MSG As String 'déclare la variable MSG (MeSsaGe)
Dim LAF() As Integer 'déclare la variable PAF (Ligne À Effacer)
Dim PLAF As Range 'déclare la variable PLAF (Plage des Lignes À Effacer)

Set O = Worksheets("Feuil1") 'définit l'onglet O
TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If TV(I, 13) = "" Or TV(I, 14) = "" Or TV(I, 17) = "" Then GoTo suite 'si une des 3 valeurs est vide, va à l'étiquette "suite"
    If TV(I, 13) = "x" Or TV(I, 14) = "x" Or TV(I, 17) = "x" Then GoTo suite 'si une des 3 valeurs vaut "x", va à l'étiquette "suite"
    If TV(I, 17) <> "attente" Then GoTo suite 'si la colonne Q est différente de "attente", va à l'étiquette "suite"
        D(TV(I, 13) & TV(I, 14) & TV(I, 17)) = "" 'alimente le dictionnaire D avec les 3 valeurs concaténées
suite: 'étiquette
Next I 'prochaine ligne de la boucle
TMP = D.keys 'alimente le tableau temporaire TMP avec la liste du dictionnaire D sans doublons (les clés)
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire TMP
    PL = 0 'initialise la première ligne PL
    For I = 2 To UBound(TV, 1) 'boucle 2 sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 13) & TV(I, 14) & TV(I, 17) = TMP(J) Then 'condition 1 : si les 3 valeurs concatenées sont égales à TMP(J)
            If PL <> 0 Then 'condition 2 : si la première ligne est différente de 0
                K = K + 1 'incrémente K
                ReDim Preserve LAF(1 To K) 'redimensionne le tableau des lignes à effacer LAF
                LAF(K) = I 'récupère la ligne I de la boucle 2 dans le tableau LAF
            Else 'sinon (si s'est la première ligne)
                PL = I 'définit la première ligne PL
                'définit le message MSG
                MSG = IIf(MSG = "", "Les premières Lignes sont :" & vbCrLf & I & " - " & TV(I, 13) & " - " & TV(I, 14) & " - " & TV(I, 17), _
                   MSG & vbCrLf & I & " - " & TV(I, 13) & " - " & TV(I, 14) & " - " & TV(I, 17))
            End If 'fin de la condition 2
        End If 'fin de la condition 1
    Next I 'prochaine ligne de la boucle 2
Next J 'prochain élément de la boucle 1
Set PLAF = O.Range("A1") 'initialise la plage PLAF
For I = LBound(LAF) To UBound(LAF) 'boucle sur toutes les lignes du tableau des ligne à effacer LAF
    Set PLAF = IIf(PLAF.Cells.Count = 1, O.Rows(LAF(I)), Application.Union(PLAF, O.Rows(LAF(I)))) 'redéfinit la plage PLAF
Next I 'prochaine ligne de la boucle
PLAF.Select 'sélectionne la plage PLAF
MsgBox MSG & vbCrLf & "Seuls les donblons sont sélectionnés !"
End Sub

Il ne supprime pas il sélectionne juste... Tu n'auras plus qu'à faire la combinaison de toucches [CTRL] + [-] pour supprimer mais je préfère te laisser vérifier d'abord.

Bonjour a toi et merci de voir ça.
J'ai copié collé et ça me sélectionne les lignes mais moi ce que je voudrais c'est que sans que les lignes doublons soient effacées que le terme "attente" soit pas inscrit et/ou que le prix soit aussi non visible.

Robert · 23 Janvier 2022

Re,

Supprimer les doublons qui possèdent un "ACHAT" en colonne "M" avec un "ATTENTE" en colonne "Q" et qui ont le même prix en "N" comme en cellule "N88" et cellule " N 192 ". A conserver le premier et faire disparaître les suivants. La même chose pour "N249" et "N283"

C'est pas ce que tu as dit il me semble. Pour moi, supprimer les doublons, c'est : supprimer les doublons...

alain.pierrephie · 23 Janvier 2022

Robert à dit:
Re,

C'est pas ce que tu as dit il me semble. Pour moi, supprimer les doublons, c'est : supprimer les doublons...

OK je m'en arrange comme ça en fait ça sélectionne les doublons et j'ai juste a faire "suppr"
merci a toi pour ton aide, ça me va comme ça.
Salut a toi et bonne semaine

Robert · 23 Janvier 2022

Re,

VB:

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim PL As Integer 'déclare la variable PL (Première Ligne)

Set O = Worksheets("Feuil1") 'définit l'onglet O
TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If TV(I, 13) = "" Or TV(I, 14) = "" Or TV(I, 17) = "" Then GoTo suite 'si une des 3 valeurs est vide, va à l'étiquette "suite"
    If TV(I, 13) = "x" Or TV(I, 14) = "x" Or TV(I, 17) = "x" Then GoTo suite 'si une des 3 valeurs vaut "x", va à l'étiquette "suite"
    If TV(I, 17) <> "attente" Then GoTo suite 'si la colonne Q est différente de "attente", va à l'étiquette "suite"
        D(TV(I, 13) & TV(I, 14) & TV(I, 17)) = "" 'alimente le dictionnaire D avec les 3 valeurs concaténées
suite: 'étiquette
Next I 'prochaine ligne de la boucle
TMP = D.keys 'alimente le tableau temporaire TMP avec la liste du dictionnaire D sans doublons (les clés)
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire TMP
    PL = 0 'initialise la première ligne PL
    For I = 2 To UBound(TV, 1) 'boucle 2 sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 13) & TV(I, 14) & TV(I, 17) = TMP(J) Then 'condition 1 : si les 3 valeurs concatenées sont égales à TMP(J)
            If PL <> 0 Then 'condition 2 : si la première ligne est différente de 0
                K = K + 1 'incrémente K
                ReDim Preserve LAF(1 To K) 'redimensionne le tableau des lignes à effacer LAF
                O.Cells(I, 14).Value = "" 'efface la cellule ligne I colonne 14 de l'onglet O
                O.Cells(I, 17).Value = "" 'efface la cellule ligne I colonne 17 de l'onglet O
            Else 'sinon (si s'est la première ligne)
                PL = I 'définit la première ligne PL
            End If 'fin de la condition 2
        End If 'fin de la condition 1
    Next I 'prochaine ligne de la boucle 2
Next J 'prochain élément de la boucle 1
End Sub

alain.pierrephie · 23 Janvier 2022

Robert à dit:

Re,

VB:

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim PL As Integer 'déclare la variable PL (Première Ligne)

Set O = Worksheets("Feuil1") 'définit l'onglet O
TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If TV(I, 13) = "" Or TV(I, 14) = "" Or TV(I, 17) = "" Then GoTo suite 'si une des 3 valeurs est vide, va à l'étiquette "suite"
    If TV(I, 13) = "x" Or TV(I, 14) = "x" Or TV(I, 17) = "x" Then GoTo suite 'si une des 3 valeurs vaut "x", va à l'étiquette "suite"
    If TV(I, 17) <> "attente" Then GoTo suite 'si la colonne Q est différente de "attente", va à l'étiquette "suite"
        D(TV(I, 13) & TV(I, 14) & TV(I, 17)) = "" 'alimente le dictionnaire D avec les 3 valeurs concaténées
suite: 'étiquette
Next I 'prochaine ligne de la boucle
TMP = D.keys 'alimente le tableau temporaire TMP avec la liste du dictionnaire D sans doublons (les clés)
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire TMP
    PL = 0 'initialise la première ligne PL
    For I = 2 To UBound(TV, 1) 'boucle 2 sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 13) & TV(I, 14) & TV(I, 17) = TMP(J) Then 'condition 1 : si les 3 valeurs concatenées sont égales à TMP(J)
            If PL <> 0 Then 'condition 2 : si la première ligne est différente de 0
                K = K + 1 'incrémente K
                ReDim Preserve LAF(1 To K) 'redimensionne le tableau des lignes à effacer LAF
                O.Cells(I, 14).Value = "" 'efface la cellule ligne I colonne 14 de l'onglet O
                O.Cells(I, 17).Value = "" 'efface la cellule ligne I colonne 17 de l'onglet O
            Else 'sinon (si s'est la première ligne)
                PL = I 'définit la première ligne PL
            End If 'fin de la condition 2
        End If 'fin de la condition 1
    Next I 'prochaine ligne de la boucle 2
Next J 'prochain élément de la boucle 1
End Sub

C'es quoi ? Une autre version ? Qui change quoi ?
Merci de ta réponse

alain.pierrephie · 23 Janvier 2022

laurent950 à dit:

Bonsoir @alain.pierrephie , @Robert

une autre solution :

VB:

Dim i As Long
    Set rgn = ActiveSheet.Range("A1").CurrentRegion
' 13/17/14
    For i = 2 To rgn.Rows.Count
        If rgn(i, 13) = "ACHAT" And rgn(i, 17) = "attente" Then
            Debug.Print rgn(i, 13) & rgn(i, 17) & rgn(i, 14)
            On Error Resume Next
            cln.Add i, rgn(i, 13) & rgn(i, 17) & rgn(i, 14)
            If Err.Number <> 0 Then
            ' mais moi ce que je voudrais c'est que sans que les lignes doublons soient effacées que le terme "attente" soit pas inscrit et/ou que le prix soit aussi non visible.
            ' Format de la cellume "masqué avec ";;;"
                rgn(i, 17).NumberFormat = ";;;"
                rgn(i, 14).NumberFormat = ";;;"
            'Nota pour réafficher le contenu de la  cellule / .NumberFormat = "Standard"
            End If
        End If
    Next i
End Sub

Merci a toi Laurent950 je vais voir ce que cela donne par curiosité. Encore merci a vous tous

Robert · 23 Janvier 2022

alain.pierrephie à dit:
C'es quoi ? Une autre version ? Qui change quoi ?
Merci de ta réponse

As-tu au mois testé ?!... Ligne gardée, en attente et prix effacés

alain.pierrephie · 23 Janvier 2022

Robert à dit:
As-tu au mois testé ?!... Ligne gardée, en attente et prix effacés

J'attendais ta réponse à mes questions avant de faire une bétise. Et oui ça c'est exactement ce que je voulais. T'es un chef. Je vais tester ça dans l'heure et reviens vers toi après merci encore ça m'a l'air parfait. A tout a l'heure

alain.pierrephie · 23 Janvier 2022

Robert à dit:

Re,

VB:

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim PL As Integer 'déclare la variable PL (Première Ligne)

Set O = Worksheets("Feuil1") 'définit l'onglet O
TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If TV(I, 13) = "" Or TV(I, 14) = "" Or TV(I, 17) = "" Then GoTo suite 'si une des 3 valeurs est vide, va à l'étiquette "suite"
    If TV(I, 13) = "x" Or TV(I, 14) = "x" Or TV(I, 17) = "x" Then GoTo suite 'si une des 3 valeurs vaut "x", va à l'étiquette "suite"
    If TV(I, 17) <> "attente" Then GoTo suite 'si la colonne Q est différente de "attente", va à l'étiquette "suite"
        D(TV(I, 13) & TV(I, 14) & TV(I, 17)) = "" 'alimente le dictionnaire D avec les 3 valeurs concaténées
suite: 'étiquette
Next I 'prochaine ligne de la boucle
TMP = D.keys 'alimente le tableau temporaire TMP avec la liste du dictionnaire D sans doublons (les clés)
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire TMP
    PL = 0 'initialise la première ligne PL
    For I = 2 To UBound(TV, 1) 'boucle 2 sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 13) & TV(I, 14) & TV(I, 17) = TMP(J) Then 'condition 1 : si les 3 valeurs concatenées sont égales à TMP(J)
            If PL <> 0 Then 'condition 2 : si la première ligne est différente de 0
                K = K + 1 'incrémente K
                ReDim Preserve LAF(1 To K) 'redimensionne le tableau des lignes à effacer LAF
                O.Cells(I, 14).Value = "" 'efface la cellule ligne I colonne 14 de l'onglet O
                O.Cells(I, 17).Value = "" 'efface la cellule ligne I colonne 17 de l'onglet O
            Else 'sinon (si s'est la première ligne)
                PL = I 'définit la première ligne PL
            End If 'fin de la condition 2
        End If 'fin de la condition 1
    Next I 'prochaine ligne de la boucle 2
Next J 'prochain élément de la boucle 1
End Sub

ReDim Preserve LAF(1 To K) 'redimensionne le tableau des lignes à effacer LAF
J'ai un message d'erreur "Erreur de compilation" "variable non définie" si tu vois ce que c'est !!!

Robert · 23 Janvier 2022

Re,

Oui pardon j'ai corrigé à l'arrache... Cette partie du code n'est plus utile :

VB:

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim PL As Integer 'déclare la variable PL (Première Ligne)

Set O = Worksheets("Feuil1") 'définit l'onglet O
TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If TV(I, 13) = "" Or TV(I, 14) = "" Or TV(I, 17) = "" Then GoTo suite 'si une des 3 valeurs est vide, va à l'étiquette "suite"
    If TV(I, 13) = "x" Or TV(I, 14) = "x" Or TV(I, 17) = "x" Then GoTo suite 'si une des 3 valeurs vaut "x", va à l'étiquette "suite"
    If TV(I, 17) <> "attente" Then GoTo suite 'si la colonne Q est différente de "attente", va à l'étiquette "suite"
        D(TV(I, 13) & TV(I, 14) & TV(I, 17)) = "" 'alimente le dictionnaire D avec les 3 valeurs concaténées
suite: 'étiquette
Next I 'prochaine ligne de la boucle
TMP = D.keys 'alimente le tableau temporaire TMP avec la liste du dictionnaire D sans doublons (les clés)
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire TMP
    PL = 0 'initialise la première ligne PL
    For I = 2 To UBound(TV, 1) 'boucle 2 sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 13) & TV(I, 14) & TV(I, 17) = TMP(J) Then 'condition 1 : si les 3 valeurs concatenées sont égales à TMP(J)
            If PL <> 0 Then 'condition 2 : si la première ligne est différente de 0
                O.Cells(I, 14).Value = "" 'efface la cellule ligne I colonne 14 de l'onglet O
                O.Cells(I, 17).Value = "" 'efface la cellule ligne I colonne 17 de l'onglet O
            Else 'sinon (si s'est la première ligne)
                PL = I 'définit la première ligne PL
            End If 'fin de la condition 2
        End If 'fin de la condition 1
    Next I 'prochaine ligne de la boucle 2
Next J 'prochain élément de la boucle 1
End Sub

alain.pierrephie · 23 Janvier 2022

Robert à dit:

Re,

Oui pardon j'ai corrigé à l'arrache... Cette partie du code n'est plus utile :

VB:

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim PL As Integer 'déclare la variable PL (Première Ligne)

Set O = Worksheets("Feuil1") 'définit l'onglet O
TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If TV(I, 13) = "" Or TV(I, 14) = "" Or TV(I, 17) = "" Then GoTo suite 'si une des 3 valeurs est vide, va à l'étiquette "suite"
    If TV(I, 13) = "x" Or TV(I, 14) = "x" Or TV(I, 17) = "x" Then GoTo suite 'si une des 3 valeurs vaut "x", va à l'étiquette "suite"
    If TV(I, 17) <> "attente" Then GoTo suite 'si la colonne Q est différente de "attente", va à l'étiquette "suite"
        D(TV(I, 13) & TV(I, 14) & TV(I, 17)) = "" 'alimente le dictionnaire D avec les 3 valeurs concaténées
suite: 'étiquette
Next I 'prochaine ligne de la boucle
TMP = D.keys 'alimente le tableau temporaire TMP avec la liste du dictionnaire D sans doublons (les clés)
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire TMP
    PL = 0 'initialise la première ligne PL
    For I = 2 To UBound(TV, 1) 'boucle 2 sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 13) & TV(I, 14) & TV(I, 17) = TMP(J) Then 'condition 1 : si les 3 valeurs concatenées sont égales à TMP(J)
            If PL <> 0 Then 'condition 2 : si la première ligne est différente de 0
                O.Cells(I, 14).Value = "" 'efface la cellule ligne I colonne 14 de l'onglet O
                O.Cells(I, 17).Value = "" 'efface la cellule ligne I colonne 17 de l'onglet O
            Else 'sinon (si s'est la première ligne)
                PL = I 'définit la première ligne PL
            End If 'fin de la condition 2
        End If 'fin de la condition 1
    Next I 'prochaine ligne de la boucle 2
Next J 'prochain élément de la boucle 1
End Sub

Merci Robert, j'essaie ça demain matin et reviendrais vers toi après.
A+ et merci beaucoup à toi de t'être occupé de moi

alain.pierrephie · 23 Janvier 2022

Robert à dit:

Re,

Oui pardon j'ai corrigé à l'arrache... Cette partie du code n'est plus utile :

VB:

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim PL As Integer 'déclare la variable PL (Première Ligne)

Set O = Worksheets("Feuil1") 'définit l'onglet O
TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If TV(I, 13) = "" Or TV(I, 14) = "" Or TV(I, 17) = "" Then GoTo suite 'si une des 3 valeurs est vide, va à l'étiquette "suite"
    If TV(I, 13) = "x" Or TV(I, 14) = "x" Or TV(I, 17) = "x" Then GoTo suite 'si une des 3 valeurs vaut "x", va à l'étiquette "suite"
    If TV(I, 17) <> "attente" Then GoTo suite 'si la colonne Q est différente de "attente", va à l'étiquette "suite"
        D(TV(I, 13) & TV(I, 14) & TV(I, 17)) = "" 'alimente le dictionnaire D avec les 3 valeurs concaténées
suite: 'étiquette
Next I 'prochaine ligne de la boucle
TMP = D.keys 'alimente le tableau temporaire TMP avec la liste du dictionnaire D sans doublons (les clés)
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire TMP
    PL = 0 'initialise la première ligne PL
    For I = 2 To UBound(TV, 1) 'boucle 2 sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 13) & TV(I, 14) & TV(I, 17) = TMP(J) Then 'condition 1 : si les 3 valeurs concatenées sont égales à TMP(J)
            If PL <> 0 Then 'condition 2 : si la première ligne est différente de 0
                O.Cells(I, 14).Value = "" 'efface la cellule ligne I colonne 14 de l'onglet O
                O.Cells(I, 17).Value = "" 'efface la cellule ligne I colonne 17 de l'onglet O
            Else 'sinon (si s'est la première ligne)
                PL = I 'définit la première ligne PL
            End If 'fin de la condition 2
        End If 'fin de la condition 1
    Next I 'prochaine ligne de la boucle 2
Next J 'prochain élément de la boucle 1
End Sub

J'ai eu le temps de le faire et c'est presque parfait c'est donc EXACTEMENT ce que je voulais mais lorsque je lance la macro elle fait le job mais un doublon se remet en place sur la ligne suivante et ainsi de suite quand je déclenche la macro jusqu'a ce que les doublons de s'affiche plus. Est ce que cette macro qui est parfaite pourrait se déclencher 5 fois quand on déclenche la macro une fois, comme cela ça épuiserait les autres doublons qui s'afficheraient à nouveau. J'espère m'être expliqué de manière compréhensive. Je reste a l'ordi jusqu'a minuit au cas ou tu serais là. Merci a toi

Autres Suppression de doublons comportant 3 données en commun. Une seule ligne sera conservée

alain.pierrephie

XLDnaute Occasionnel

Pièces jointes

Robert

XLDnaute Barbatruc

alain.pierrephie

XLDnaute Occasionnel

Robert

XLDnaute Barbatruc

alain.pierrephie

XLDnaute Occasionnel

Robert

XLDnaute Barbatruc

alain.pierrephie

XLDnaute Occasionnel

alain.pierrephie

XLDnaute Occasionnel

Robert

XLDnaute Barbatruc

alain.pierrephie

XLDnaute Occasionnel

alain.pierrephie

XLDnaute Occasionnel

Robert

XLDnaute Barbatruc

alain.pierrephie

XLDnaute Occasionnel

alain.pierrephie

XLDnaute Occasionnel

Autres Suppression de doublons comportant 3 données en commun. Une seule ligne sera conservée

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

Privacy & Transparency

Privacy & Transparency