Extraire valeurs Uniques d'une plage et mettre sur une seule ligne

[Shpountz]

Bonjour à tous

Je souhaiterais extraire les valeurs uniques d'une plage de cellules et de les mettre sur une seule ligne...
Est ce possible ?

Amicalement
François

 

[Robert]

Bonjour Shpountz, bonjour le forum,

Essaie comme ça :

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)

Set O = Worksheets("Feuil1") 'définit l'onglet O (à adapter à ton cas)
TV = O.Range("B2").CurrentRegion 'définit le tableau des valeurs TV (à adapter à ton cas)
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 1 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV
    For J = 1 To UBound(TV, 2) 'boucle 2 : sur toutes les colonnes J du tableau des valeurs TV
        If TV(I, J) <> "" Then D(TV(I, J)) = "" 'si la donnée ligne I colonne J de TV n'est pas vide, alimente le dictionnaire D avec la donnée
    Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
O.Range("I11").Resize(1, D.Count).Value = D.keys 'renvoie dans I11 (cellule à adapter) redimensionnée de l'onglet O les éléments du dictionanire D asns doublon
End Sub

 

[pierrejean]

bonjour Francois

A tester

EDit : Salut ROBERT

 

[Shpountz]

Bonjour Robert, Bonjour Pierre Jean

Merci pour votre aide.

Robert concernant le VBA je suis nul...
Pour le module pas de soucis mais comment faire pour adapter a mon besoin ?
Les données à extraire font partie d'une feuille et je ne souhaite pas lancer le VBA sur toute la feuille mais juste sur une partie de celle-ci
Je pense que je dois préciser ou se trouve la plage a extraire et lui donner un endroit ou inscrire le résultat


Pierre Jean
En fait je souhaite obtenir toute les valeurs uniques et la macro me donne les doublons
En fait la MFC sur mon tableau n'était présente que pour m'aider à trouver les valeurs non en double...

Maintenant je m'aperçois que je me suis peut être mal exprimé...
En fait je souhaite obtenir une liste dédoublonnée et incluant les autres valeurs aussi

si j'ai
1 2 3 4
et
1 2 3 5

le résultat devrait être 1 2 3 4 5

Merci encore pour votre aide
Amicalement
François

 

[job75]

Bonjour Shpountz, Robert, Pierre,

A priori c'est le même problème que sur ce fil :

https://www.excel-downloads.com/threads/vba-ou-formule-doublons-sur-lignes.20016801/

Il y a des solutions par formules et j'ai donné 2 solutions VBA aux posts #13 et #16.

A+

 

[Shpountz]

Re bonjour Job75
Effectivement je pense que cela apporte la solution à mon problème et je devrais savoir l'adapter

Un grand merci
Amicalement
François

 

[hamphilos]

bonjour Francois

A tester

EDit : Salut ROBERT

Bonjour @pierrejean
Pouvez-vous s'il vous plaît nous indiquer comment modifier la macro pour avoir les résultats sur une colonne et non sur une ligne?
Merci d'avance pour votre précieuse aide.

Sub test()
Set d = CreateObject("Scripting.dictionary")
Range("B2:G5").Select
For Each cel In Selection
If cel.Value <> "" Then
x = cel.Value
d(x) = x
End If
Next
Range("I11").Resize(, UBound(d.keys)) = d.keys
End Sub

 

[job75]

Bonjour hamphilos,

pierrejean n'est peut-être pas disponible, je réponds à sa place.

Il suffit en fin de macro de remplacer :

Range("I11").Resize(, UBound(d.keys)) = d.keys

par :

Range("I11").Resize(d.Count) = Application.Transpose(d.keys)

Edit: pierrejean s'est trompé, il faut utiliser d.Count à la place de UBound(d.keys)

Attention, la fonction Transpose est limitée à 65536 lignes.

Au-delà il faut faire une boucle pour transposer le tableau.

A+

 

[hamphilos]

Bonjour hamphilos,

pierrejean n'est peut-être pas disponible, je réponds à sa place.

Il suffit en fin de macro de remplacer :

Range("I11").Resize(, UBound(d.keys)) = d.keys

par :

Range("I11").Resize(d.Count) = Application.Transpose(d.keys)

Edit: pierrejean s'est trompé, il faut utiliser d.Count à la place de UBound(d.keys)

Attention, la fonction Transpose est limitée à 65536 lignes.

Au-delà il faut faire une boucle pour transposer le tableau.

A+

Bonjour @job75
Je viens de tester et ça fonctionne super bien. Merci infiniment pour ton aide précieuse, c'est très apprécié.
Salutations.