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

A

alain.pierrephie

XLDnaute Occasionnel
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
 

Pièces jointes

  • Aide.xlsm
    85.8 KB · Affichages: 8
Trier par date Trier par votes
Robert

Robert

XLDnaute Barbatruc
Repose en paix
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.
 
Vote positif 0 Vote négatif
A

alain.pierrephie

XLDnaute Occasionnel
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.
Cliquez pour agrandir...
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.
 
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
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"
Cliquez pour agrandir...
C'est pas ce que tu as dit il me semble. Pour moi, supprimer les doublons, c'est : supprimer les doublons...
 
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
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
 
Vote positif 0 Vote négatif
A

alain.pierrephie

XLDnaute Occasionnel
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
Cliquez pour agrandir...
C'es quoi ? Une autre version ? Qui change quoi ?
Merci de ta réponse
 
Vote positif 0 Vote négatif
A

alain.pierrephie

XLDnaute Occasionnel
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
Cliquez pour agrandir...
Merci a toi Laurent950 je vais voir ce que cela donne par curiosité. Encore merci a vous tous
 
Vote positif 0 Vote négatif
A

alain.pierrephie

XLDnaute Occasionnel
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
Cliquez pour agrandir...
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 !!!
 
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
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
 
Vote positif 0 Vote négatif
A

alain.pierrephie

XLDnaute Occasionnel
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
Cliquez pour agrandir...
Merci Robert, j'essaie ça demain matin et reviendrais vers toi après.
A+ et merci beaucoup à toi de t'être occupé de moi
 
Vote positif 0 Vote négatif
A

alain.pierrephie

XLDnaute Occasionnel
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
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif

Discussions similaires

B
  • Question
XL 2016 Doublons - Remonter sur une seule ligne en créant de nouvelles colonnes
Réponses
9
Affichages
663
Benskyy
B
S
  • Question
Microsoft 365 Concatener données en double dans une même ligne (sans et avec VBA)
Réponses
5
Affichages
1 K
chris
chris
B
  • Question
Microsoft 365 rajouter une ligne au tableau en copiant les données ds les cellules désignées
Réponses
14
Affichages
1 K
blancolie
B
N
  • Question
Epurer un fichier de données avec lignes dont une seule cellule est identique
2
Réponses
21
Affichages
2 K
Nicolas 1982
N
M
  • Question
VBA: Ajouter une ligne en fin de tableau en reprenant certaines données de la dernière ligne
2 3
Réponses
41
Affichages
33 K
troopers87
troopers87
K
  • Question
XL 2010 Récuperer une ligne en fonction de deux combobox
Réponses
14
Affichages
1 K
kyasteph
K
C
  • Question
Mettre des données mensuelles (donc 12 feuilles séparées) dans une seule feuille xls
Réponses
10
Affichages
2 K
klin89
klin89
L
  • Question
[RESOLU] Organiser une ligne de données en différentes colonnes
2
Réponses
24
Affichages
36 K
Efgé
Efgé

Membres actuellement en ligne

14 membres et 125 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 235
Messages
2 117 632
Membres
113 215
dernier inscrit
guillet