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

F
  • Résolu(e)
XL 2021 recherche doublons dans colonne puis suppression des lignes
Réponses
5
Affichages
156
ftpo69
F
F
  • Question
Microsoft 365 Copie doublons
Réponses
10
Affichages
409
job75
job75
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Couleur unique à chaque doublon différent
Réponses
11
Affichages
355
chaelie2015
chaelie2015
T
  • Question
XL 2016 SI INDEX EQUIV Doublons...
Réponses
8
Affichages
154
Titiem
T
V
  • Question
XL 2019 Numéro d'ordre automatique
Réponses
1
Affichages
153
vilcoyotte90
V
M
  • Question
Microsoft 365 Somme.Si en enlevant les doublons
Réponses
3
Affichages
124
DJunqueira
D
M
  • Question
Microsoft 365 En tete de column premiere valeur nulle (avec critère)
Réponses
5
Affichages
362
sylvanu
sylvanu
A
  • Résolu(e)
Microsoft 365 Correction d'un code vba
2
Réponses
22
Affichages
742
AD95
A
A
  • Question
XL pour MAC nettoyage et tri de données
2
Réponses
24
Affichages
716
agnesd
A
A
  • Question
XL 2016 Transfert de valeur
Réponses
10
Affichages
307
TooFatBoy
TooFatBoy

Membres actuellement en ligne

17 membres et 382 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
312 095
Messages
2 085 248
Membres
102 835
dernier inscrit
Alexandrax971