extraction sans doublon macro en ligne

GHISLAIN

XLDnaute Impliqué
bonjour,

j'ai trouvé une macro qui effectue le l'extraction des colonnes abc , et les transpose en feuille resultat merci a son auteur,

je cherche a effectuer la meme chose (uniquement par macro ) mais en recuperant la ligne 2 de la feuille source et transposer en feuille RecupLigne en colonne B les valeurs sans doublon .



si possible triées ; NB les valeurs de cette ligne ne pourront pas etre triées avant l'execution de la macro
cette ligne pourra contenir des lettres des chiffres et des cases vides

cordialement

merci a tous de votre aide et suggestion
 

Fichiers joints

Robert

XLDnaute Barbatruc
Re : extraction sans doublon macro en ligne

Bonjour Ghislain, bonjour le forum,

Peut-ête comme ça :
Code:
Sub Macro1()
Dim s As Object 'déclare la variable s (onglet Source)
Dim rl As Object 'déclare la variable rl (onglet RecupLigne)
Dim dc As Integer 'déclare la variable dc (Dernière Colonne)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim d As Object 'déclare la variable d (Dictionnaire)

Set s = Sheets("Source") 'définit l'onglet s
Set rl = Sheets("RecupLigne") 'définit l'onglet dl
rl.Range("B2").CurrentRegion.Clear 'supprime les anciennes données
dc = s.Cells(2, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée dc de la ligne 2
Set d = CreateObject("Scripting.Dictionary") 'définit le dictionnaire d
For Each cel In s.Range(s.Cells(2, 2), s.Cells(2, dc)) 'boucle sur toutes les cellules éditées cel de la ligne 2
    If cel.Value <> "" Then d(cel.Value) = "" 'alimente le dictionnaire
Next cel 'prochaine cellule de la boucle
rl.Range("B2").Resize(d.Count) = Application.Transpose(d.keys) 'place la liste sans doublons à partir de B2 de l'onglet rl
rl.Range("B2").CurrentRegion.Sort Key1:=rl.Range("B2"), Order1:=xlAscending, Header:=xlNo 'tri la liste sans doublons
End Sub
 

GHISLAIN

XLDnaute Impliqué
Re : extraction sans doublon macro en ligne

bonjour Robert,

merci d'etre passé sur mon fil , et d'avoir solutionné ma demande .
la macro proposée fonctionne parfaitement .
cordialement
GHISLAIN
 

GHISLAIN

XLDnaute Impliqué
Re : extraction sans doublon macro en ligne

bonjour robert,

serait il possible avec le code proposé , d'obtenir la meme chose mais que le resultat obtenue soit mit en ligne . soit sur la ligne 6 a partir de la colonne 3
je supose que c'est ici que dois etre changé le code ,


rl.Range("B2").Resize(d.Count) = Application.Transpose(d.keys) 'place la liste sans doublons à partir de B2 de l'onglet rl

j'ai tenté par rl.Range(rows(6,6).Resize(d.Count) = Application.Transpose(d.keys)
mais sans resultat

pourrais tu m'aiguiller ??

juste pour info j'avais une erreur sur la ligne :

rl.Range("B2").CurrentRegion.Sort Key1:=rl.Range("B2"), Order1:=xlAscending, Header:=xlN0 me donnant une erreur 1004

j'ai donc remplacer par un with et end with

cordialement
ghislain
 

laetitia90

XLDnaute Barbatruc
Re : extraction sans doublon macro en ligne

bonjour tous :):):)
essai comme cela

Code:
Dim t, x As Variant, m As Object
 Set m = CreateObject("Scripting.Dictionary")
 x = Feuil1.Cells(2, 1).Resize(, Feuil1.Cells.Find("*", , , , xlByColumns, xlPrevious).Column).Value
 For Each t In x: m(t) = t: Next t
 Feuil4.[c6].Resize(1, m.Count) = m.keys
ps j'ai oublie si on veut mettre dans l'ordre alpha...
ligne a rajouter a la fin du code

Code:
Feuil4.Range("c6:iv6").Sort Orientation:=xlLeftToRight, Key1:=Feuil4.Rows(6), Order1:=xlAscending, Header:=xlGuess
 
Dernière édition:

Robert

XLDnaute Barbatruc
Re : extraction sans doublon macro en ligne

Bonjour Ghislain, bonjour le forum,

Essaie comme ça :
Code:
Sub Macro1()
Dim s As Object 'déclare la variable s (onglet Source)
Dim rl As Object 'déclare la variable rl (onglet RecupLigne)
Dim dc As Integer 'déclare la variable dc (Dernière Colonne)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim d As Object 'déclare la variable d (Dictionnaire)

Set s = Sheets("Source") 'définit l'onglet s
Set rl = Sheets("RecupLigne") 'définit l'onglet dl
rl.Range("B2").CurrentRegion.Clear 'supprime les anciennes données
dc = s.Cells(2, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée dc de la ligne 2
Set d = CreateObject("Scripting.Dictionary") 'définit le dictionnaire d
For Each cel In s.Range(s.Cells(2, 2), s.Cells(2, dc)) 'boucle sur toutes les cellules éditées cel de la ligne 2
    If cel.Value <> "" Then d(cel.Value) = "" 'alimente le dictionnaire
Next cel 'prochaine cellule de la boucle
rl.Range("C6").Resize(d.Count) = Application.Transpose(d.keys) 'place la liste sans doublons à partir de B2 de l'onglet rl
rl.Range("C6").CurrentRegion.Sort Key1:=rl.Range("C6"), Order1:=xlAscending, Header:=xlNo 'tri la liste sans doublons
End Sub
[Édition]
Bonjour Leatitia on s'est croisé...
 

GHISLAIN

XLDnaute Impliqué
Re : extraction sans doublon macro en ligne

bonjour a tous,

desolé du retard , merci a tous de vos suggestions qui fonctionnent a merveillle

amicalement

ghislain
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas