Microsoft 365 Doublons si valeur unique ou nulle

E

ExcLnoob

XLDnaute Occasionnel
Bonsoir le Forum,
J'aurai besoin de votre aide svp...

Je dois reporter des données d'une colonne d'un onglet à une autre colonne dans un autre onglet selon 1 condition et après, copier ces données dans une autre colonne en supprimant les doublons.
J'ai trouvé des bouts de code qui me permettent de le faire mais je dois renouveler cette opération toutes les semaines et parfois il n'y aura pas de doublon dans la colonne source et par conséquent dans la colonne où seront reportées les données et où la recherche de doublons devra se faire et il n'y aura parfois qu'une seule valeur.
C'est là que je bloque..
Comment écrire que si valeur unique dans la colonne où je dois chercher les doublons alors copier cette même valeur unique dans la colonne cible et que si valeur nulle (aucune donnée) alors on inscris rien dans la colonne cible.

Je ne sais pas si j'exprime bien ma demande. Je mets un fichier test pour plus de clarté.

Merci pour votre aide.
 

Pièces jointes

  • Classeur2.xlsm
    18.5 KB · Affichages: 16
Solution
cp4
ExcLnoob à dit:
Oui effectivement, le chemin a changé mais pas la demande...
J'ai toujours eu besoin de faire l'exercice sur plusieurs noms mais comme je bloquais sur le filtre je ne l'ai pas indiqué dès le départ.
Au temps pour moi...
Ta solution du dictionnaire a considérablement boosté le traitement des doublons et résout mon problème quand les valeurs sont unique. Merci pour ça.
Ne me reste plus qu'a faire cela pour 4 personnes en même temps sur des colonnes différentes...
Je vais creuser de mon côté.
Merci.
Cliquez pour agrandir...
Bonjour,

@ExcLnoob : Juste pour rappel, il faut respecter la charte du forum. Les formules de politesses sont de rigueur.
Un Bonjour, Un Bonsoir ne coûte rien.

Quant à ton problème, ne faudrait-il pas envisager l'éventualité...
Trier par date Trier par votes
E

ExcLnoob

XLDnaute Occasionnel
cp4 à dit:
Bonjour,

Avec une seule ligne de données, ton fichier ne reflète pas le problème posé.
je doute que tu puisses avoir un retour pour solutionner ton problème.
Cliquez pour agrandir...
Bonjour,

Merci pour ta réponse.

Justement, c'est pour avoir un cas concret que je n'ai mis qu'une seule ligne.
Si plusieurs lignes de données avec doublon, le code fonctionne.
Mon problème se pose en cas de lignes de données unique. Le code ne peut pas fonctionner car il fait un filtre et cela ne peut pas fonctionner sur un ligne unique. Je voudrais avoir les 2 options dans le code :
Si plusieurs lignes >> Filtre + retrait des doublons
Si 1 seul ligne >> Juste copier/coller la valeur -> C'est cette partie qu'il me manque

Merci
 
Vote positif 0 Vote négatif
cp4

cp4

XLDnaute Barbatruc
ExcLnoob à dit:
Bonjour,

Merci pour ta réponse.

Justement, c'est pour avoir un cas concret que je n'ai mis qu'une seule ligne.
Si plusieurs lignes de données avec doublon, le code fonctionne.
Mon problème se pose en cas de lignes de données unique. Le code ne peut pas fonctionner car il fait un filtre et cela ne peut pas fonctionner sur un ligne unique. Je voudrais avoir les 2 options dans le code :
Si plusieurs lignes >> Filtre + retrait des doublons
Si 1 seul ligne >> Juste copier/coller la valeur -> C'est cette partie qu'il me manque

Merci
Cliquez pour agrandir...
Bonjour,

Je t'avoue que je n'ai pas compris ton problème. Ton code copie le numéro du nom "XXXX" dans la seconde feuille.
Je ne comprends pas l'utilisation de "Select Case" alors qu'un simple If aurait suffit.
Ton code plante lors du tri. Ce qui est tout à fait normal car il n'y a qu'une ligne.
Quant aux doublons, tu peux utiliser un dictionnaire. Ajoute On Error resume next
VB: 
Sub copy()
Dim i&
With Sheets("recap")
For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
    Select Case .Cells(i, 2).Value
        Case "XXXX"
            If .Cells(i, 2).Value = "XXXX" Then
                .Cells(i, 1).copy Sheets("Feuil2").Cells(Rows.Count, 1).End(xlUp)(2)
            End If
    End Select
Next i
End With
    Range("A2").Select
On Error Resume Next
    Range("A2:A" & Range("A65536").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets("Feuil2").Range("G2"), Unique:=True
End Sub
 
Vote positif 0 Vote négatif
E

ExcLnoob

XLDnaute Occasionnel
cp4 à dit:
Bonjour,

Je t'avoue que je n'ai pas compris ton problème. Ton code copie le numéro du nom "XXXX" dans la seconde feuille.
Je ne comprends pas l'utilisation de "Select Case" alors qu'un simple If aurait suffit.
Ton code plante lors du tri. Ce qui est tout à fait normal car il n'y a qu'une ligne.
Quant aux doublons, tu peux utiliser un dictionnaire. Ajoute On Error resume next
VB: 
Sub copy()
Dim i&
With Sheets("recap")
For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
    Select Case .Cells(i, 2).Value
        Case "XXXX"
            If .Cells(i, 2).Value = "XXXX" Then
                .Cells(i, 1).copy Sheets("Feuil2").Cells(Rows.Count, 1).End(xlUp)(2)
            End If
    End Select
Next i
End With
    Range("A2").Select
On Error Resume Next
    Range("A2:A" & Range("A65536").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets("Feuil2").Range("G2"), Unique:=True
End Sub
Cliquez pour agrandir...
Bonjour,

Merci pour ta réponse.

Je me suis sans doute mal expliqué..
Dans mon fichier de travail, j'ai 1000 lignes avec des agents différents en colonne B qui ont des numéros de demande en colonne A en feuil1 (symbolisé par la feuille récap dans le fichier transmis sur le forum)
Ces numéros de demande peuvent être en double, en triple ou plus.
Je souhaite copier sans doublons ses numéros de demande selon 1 critère (le nom de l'agent) dans la Feuil" (symbolisé par la colonne G dans le fichier transmis).
Le seul code que j'ai trouvé me permet de copier les numéros de demandes correspondant au critère dans la feuil2 (correspondant à la colonne A dans le fichier transmis) et ensuite de les copier sans doublon dans la feuil3 (Colonne G dans le fichier).

L'ennui c'est qu'il est possible qu'un agent n'est qu'un seul numéro de demande et de ce fait le filtre ne marche plus (logique puisqu'il n'y a qu'une seule valeur, je te rejoins) alors qu'il faut quand même que je reporte cette valeur unique.

Comment apporter une condition à mon code qui ferait qu'en cas de valeur unique cette dernière se reporte quand même en colonne G dans mon fichier transmis.
Créer une exception en quelque sorte..

Là, 'On Error Resume Next', ne fais pas la copie de la data unique de la colonne A vers la colonne G.

En espérant avoir été plus clair
 
Vote positif 0 Vote négatif
cp4

cp4

XLDnaute Barbatruc
Bonjour,
ExcLnoob à dit:
Là, 'On Error Resume Next', ne fais pas la copie de la data unique de la colonne A vers la colonne G.
Cliquez pour agrandir...
On Error Resume Next évite que la ligne de code "AdvancedFilter" ne plante car il n'y a qu'une seule.
Autrement, ça permet d'ignorer cette ligne de code en cas d'erreur.

classeur2.gif


Avec si peu de données ton fichier n'illustre pas ton problème. En VBA, il y a d'autres moyens pour arriver à tes fins. Rends anonyme les noms (ou d'autres données confidentielles) et joint un autre fichier avec le résultat attendu sur une feuille. Tel quel, je ne sais pas comment t'aider.

Bonne journée.

edit: Ma foi, si tu tiens à ton "AdvancedFilter", essaie comme ceci
VB: 
Sub copy()
   Dim i&
   With Sheets("recap")
      For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
         Select Case .Cells(i, 2).Value
         Case "XXXX"
            If .Cells(i, 2).Value = "XXXX" Then
               .Cells(i, 1).copy Sheets("Feuil2").Cells(Rows.Count, 1).End(xlUp)(2)
            End If
         End Select
      Next i
   End With
   With Sheets("Feuil2")
      If .Range("A" & Rows.Count).End(xlUp).Row = 2 Then
         .Range("G2") = .Range("A2")
      Else
         .Range("A2:A" & Range("A65536").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("G2"), Unique:=True
      End If
   End With
End Sub
Si tu as plusieurs noms, le dictionnaire est plus indiqué dans ce cas. à toi de décider.
 
Dernière édition:
Vote positif 0 Vote négatif
E

ExcLnoob

XLDnaute Occasionnel
cp4 à dit:
Bonjour,

On Error Resume Next évite que la ligne de code "AdvancedFilter" ne plante car il n'y a qu'une seule.
Autrement, ça permet d'ignorer cette ligne de code en cas d'erreur.

Regarde la pièce jointe 1162813

Avec si peu de données ton fichier n'illustre pas ton problème. En VBA, il y a d'autres moyens pour arriver à tes fins. Rends anonyme les noms (ou d'autres données confidentielles) et joint un autre fichier avec le résultat attendu sur une feuille. Tel quel, je ne sais pas comment t'aider.

Bonne journée.

edit: Ma foi, si tu tiens à ton "AdvancedFilter", essaie comme ceci
VB: 
Sub copy()
   Dim i&
   With Sheets("recap")
      For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
         Select Case .Cells(i, 2).Value
         Case "XXXX"
            If .Cells(i, 2).Value = "XXXX" Then
               .Cells(i, 1).copy Sheets("Feuil2").Cells(Rows.Count, 1).End(xlUp)(2)
            End If
         End Select
      Next i
   End With
   With Sheets("Feuil2")
      If .Range("A" & Rows.Count).End(xlUp).Row = 2 Then
         .Range("G2") = .Range("A2")
      Else
         .Range("A2:A" & Range("A65536").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("G2"), Unique:=True
      End If
   End With
End Sub
Si tu as plusieurs noms, le dictionnaire est plus indiqué dans ce cas. à toi de décider.
Cliquez pour agrandir...
Bonjour,

Merci encore pour ton aide.
Je ne connais pas le dictionnaire dont tu parles et effectivement j'ai plusieurs noms..
Je te joins un fichier un peu plus parlant à mon avis (enfin j'espère)
 

Pièces jointes

  • Classeur2.xlsm
    21.3 KB · Affichages: 7
Vote positif 0 Vote négatif
E

ExcLnoob

XLDnaute Occasionnel
ExcLnoob à dit:
Bonjour,

Merci encore pour ton aide.
Je ne connais pas le dictionnaire dont tu parles et effectivement j'ai plusieurs noms..
Je te joins un fichier un peu plus parlant à mon avis (enfin j'espère)
Cliquez pour agrandir...
J'ai testé ton dernier code sur tous mes prénoms et c'est bien le résultat escompté.
Merci !!!
Par contre, je comprends que l'on peut améliorer avec le dictionnaire. Comment peut-on faire stp ?
Parce qu'effectivement j'ai 5 noms et je dois faire l'exercice 2 fois puisque je dois faire cela avec les données de la semaine passé et celle en cours pour voir quels numéros ont été traités entre-temps et avec le code actuel je crois que je risque de bcp (trop?) soliciter EXCEL
Merci
 
Vote positif 0 Vote négatif
cp4

cp4

XLDnaute Barbatruc
ExcLnoob à dit:
J'ai testé ton dernier code sur tous mes prénoms et c'est bien le résultat escompté.
Merci !!!
Par contre, je comprends que l'on peut améliorer avec le dictionnaire. Comment peut-on faire stp ?
Parce qu'effectivement j'ai 5 noms et je dois faire l'exercice 2 fois puisque je dois faire cela avec les données de la semaine passé et celle en cours pour voir quels numéros ont été traités entre-temps et avec le code actuel je crois que je risque de bcp (trop?) soliciter EXCEL
Merci
Cliquez pour agrandir...
J'avais fait ceci en attendant ton fichier. Fais un test et vois si ça te conviens avec ce code.
VB: 
Sub SansDoublon()
   Dim Dico As Object
   Set Dico = CreateObject("scripting.dictionary")

   With Sheets("recap")
      For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
         Dico(.Cells(i, 1) & ";" & .Cells(i, 2)) = ""
      Next i
   End With
   With Sheets("Feuil2")
      .Range("A1").CurrentRegion.ClearContents
      .Range("A1").Resize(Dico.Count) = Application.Transpose(Dico.keys)
      .Columns(1).TextToColumns DataType:=xlDelimited, Other:=True, OtherChar:=";"
   End With
End Sub
 
Vote positif 0 Vote négatif
E

ExcLnoob

XLDnaute Occasionnel
cp4 à dit:
J'avais fait ceci en attendant ton fichier. Fais un test et vois si ça te conviens avec ce code.
VB: 
Sub SansDoublon()
   
Dim Dico As Object
   Set Dico = CreateObject("scripting.dictionary")

   With Sheets("recap")
      For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
         Dico(.Cells(i, 1) & ";" & .Cells(i, 2)) = ""
      Next i
   End With
   With Sheets("Feuil2")
      .Range("A1").CurrentRegion.ClearContents
      .Range("A1").Resize(Dico.Count) = Application.Transpose(Dico.keys)
      .Columns(1).TextToColumns DataType:=xlDelimited, Other:=True, OtherChar:=";"
   End With
End Sub
Cliquez pour agrandir...
Waouh ! La rapidité !!
Au top! Merci.

J'ai bien inclus la condition sur 1 nom mais à part répéter le code autant de fois que de noms avec les bonnes colonnes cibles je ne vois pas.. J'ai bon ?
Le code :
VB: 
Sub SansDoublon()
Dim Dico As Object

   Set Dico = CreateObject("scripting.dictionary")

   With Sheets("recap")
      For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
        If .Cells(i, 2).Value = "Paul" Then
         Dico(.Cells(i, 1) & ";") = "" '& .Cells(i, 2)) = ""
        End If
      Next i
   End With
   With Sheets("Feuil2")
      .Range("I2").CurrentRegion.ClearContents
      .Range("I2").Resize(Dico.Count) = Application.Transpose(Dico.keys)
      .Columns(9).TextToColumns DataType:=xlDelimited, Other:=True, OtherChar:=";"
   End With

End Sub

Et je penses que la ligne ci-dessous me supprime également l'entête. Entête que je souhaite conserver
.Range("I2").CurrentRegion.ClearContents
Cliquez pour agrandir...
Comment faire pour qu'elle ne supprime qu'à partir de I2 et non pas toute la colonne ?

Merci encore !
 
Vote positif 0 Vote négatif
cp4

cp4

XLDnaute Barbatruc
ExcLnoob à dit:
Dico(.Cells(i, 1) & ";") = ""
Cliquez pour agrandir...
Je ne vois pas trop l'utilité de concaténer avec un point virgule (;).
Ce que j'avais fait est très différent. En effet, les vrais doublons sont le numéro+le nom, c'est pour cela que j'ai utilisé une concaténation pour ne récupérer que des paires uniques.
J'avoue que je ne comprends pas trop ta démarche.

For i=1 veut dire qu'on boucle à partir de la 1ère ligne de la feuille ==> que l’entête est dans le code.

.Range("I2").CurrentRegion.ClearContents
Cliquez pour agrandir...
En effet, ça efface tout.

Si tu veux garder la ligne d’entête (qui ne servira à rien, car si tu utilises le code, elle sera remise)
VB: 
.Range("I1").CurrentRegion.offset(1).ClearContents
Sinon, je n'ai pas bien compris.
 
Vote positif 0 Vote négatif
E

ExcLnoob

XLDnaute Occasionnel
ExcLnoob à dit:
Waouh ! La rapidité !!
Au top! Merci.

J'ai bien inclus la condition sur 1 nom mais à part répéter le code autant de fois que de noms avec les bonnes colonnes cibles je ne vois pas.. J'ai bon ?
Le code :
VB: 
Sub SansDoublon()
Dim Dico As Object

   Set Dico = CreateObject("scripting.dictionary")

   With Sheets("recap")
      For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
        If .Cells(i, 2).Value = "Paul" Then
         Dico(.Cells(i, 1) & ";") = "" '& .Cells(i, 2)) = ""
        End If
      Next i
   End With
   With Sheets("Feuil2")
      .Range("I2").CurrentRegion.ClearContents
      .Range("I2").Resize(Dico.Count) = Application.Transpose(Dico.keys)
      .Columns(9).TextToColumns DataType:=xlDelimited, Other:=True, OtherChar:=";"
   End With

End Sub

Et je penses que la ligne ci-dessous me supprime également l'entête. Entête que je souhaite conserver

Comment faire pour qu'elle ne supprime qu'à partir de I2 et non pas toute la colonne ?

Merci encore !
Cliquez pour agrandir...
cp4 à dit:
Je ne vois pas trop l'utilité de concaténer avec un point virgule (;).
Ce que j'avais fait est très différent. En effet, les vrais doublons sont le numéro+le nom, c'est pour cela que j'ai utilisé une concaténation pour ne récupérer que des paires uniques.
J'avoue que je ne comprends pas trop ta démarche.

For i=1 veut dire qu'on boucle à partir de la 1ère ligne de la feuille ==> que l’entête est dans le code.


En effet, ça efface tout.

Si tu veux garder la ligne d’entête (qui ne servira à rien, car si tu utilises le code, elle sera remise)
VB: 
.Range("I1").CurrentRegion.offset(1).ClearContents
Sinon, je n'ai pas bien compris.
Cliquez pour agrandir...
Oups, je comprends que j'ai "dévié" ton code...
Effectivement pour le point virgule, erreur corrigée
L'objectif est d'avoir le même résultat pour chaque prénoms en même temps car les colonnes cibles me permettent de calculer quelles données n'apparaissent plus d'une semaine sur l'autre et ainsi de suivre l'évolution et de ce fait créer un graphique de suivi pour reporting (je sais pas si jai été clair là...)
 
Vote positif 0 Vote négatif
E

ExcLnoob

XLDnaute Occasionnel
ExcLnoob à dit:
Oups, je comprends que j'ai "dévié" ton code...
Effectivement pour le point virgule, erreur corrigée
L'objectif est d'avoir le même résultat pour chaque prénoms en même temps car les colonnes cibles me permettent de calculer quelles données n'apparaissent plus d'une semaine sur l'autre et ainsi de suivre l'évolution et de ce fait créer un graphique de suivi pour reporting (je sais pas si jai été clair là...)
Cliquez pour agrandir...
A mon avis c'est pour cela que le select case pouvais être pertinent non ?
Dans le cas de Jacques on copie en colonne I
Dans le cas de Paul on copie en colonne J
Etc..
Ou alors j'ai tout faux. Qu'en penses-tu ?
 
Vote positif 0 Vote négatif

Discussions similaires

P
  • Résolu(e)
XL 2021 Identifier lignes des doublons dans message Box
Réponses
5
Affichages
206
pierrof
P
M
  • Question
XL 2010 Supprimer les doublons contenant une valeur zéro avec trois conditions
Réponses
2
Affichages
451
Mody200
M
E
  • Résolu(e)
Microsoft 365 ComboBox "dynamiques" sans doublon sur plusieurs colonnes
Réponses
2
Affichages
181
ExcLnoob
E
E
  • Question
XL 2021 Doublons
Réponses
1
Affichages
223
sylvanu
sylvanu
M
  • Question
Microsoft 365 Erreurs de doublons
Réponses
6
Affichages
385
CHRIS1945
C
J
  • Question
Autres Surbrillance cellule pour doublons sur Sheets
Réponses
6
Affichages
355
jny
J
D
  • Question
XL 2021 Afficher une valeur qu'une seule fois si un critére est atteint
Réponses
13
Affichages
674
JHA
J
Z
  • Résolu(e)
Microsoft 365 (résolu) Position d'une valeur max dans un tableau avec ex-aequo
2
Réponses
15
Affichages
534
crocrocro
C
F
  • Résolu(e)
XL 2021 recherche doublons dans colonne puis suppression des lignes
Réponses
5
Affichages
518
ftpo69
F
lestoiles1
  • Résolu(e)
XL 2013 Effacer le contenu si la valeur n'est pas entre 13000 90000 et copier les valeurs dupliqués
Réponses
8
Affichages
186
lestoiles1
lestoiles1

Membres actuellement en ligne

4 membres et 50 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 097
Messages
2 116 186
Membres
112 679
dernier inscrit
Yupanki