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
 

Pièces jointes

  • ListeSansDoublon.zip
    17.6 KB · Affichages: 51
  • ListeSansDoublon.zip
    17.6 KB · Affichages: 46
  • ListeSansDoublon.zip
    17.6 KB · Affichages: 51

Robert

XLDnaute Barbatruc
Repose en paix
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,

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
Repose en paix
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é...
 

Discussions similaires

Réponses
2
Affichages
396

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof