CommentRécupérer 1 liste de valeur sous excel
Résolu
braguy13
-
Zoul67 Messages postés 1959 Date d'inscription Statut Membre Dernière intervention -
Zoul67 Messages postés 1959 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
dans un tableau du type 5 colonnes et 3 lignes
1/ /2/1/ 3
/3/5/ /6
2/3/4/5/6
j'aimerais via une fonction ou macro récupérer la liste des valeurs distinctes
le résultat dans notre exemple :
1,2,3,4,5,6 sur le range A1:E3
avez vous une idée de comment faire simplmeent ?
Merci par avance
braguy13
dans un tableau du type 5 colonnes et 3 lignes
1/ /2/1/ 3
/3/5/ /6
2/3/4/5/6
j'aimerais via une fonction ou macro récupérer la liste des valeurs distinctes
le résultat dans notre exemple :
1,2,3,4,5,6 sur le range A1:E3
avez vous une idée de comment faire simplmeent ?
Merci par avance
braguy13
A voir également:
- CommentRécupérer 1 liste de valeur sous excel
- Liste déroulante excel - Guide
- Excel liste déroulante en cascade - Guide
- Word et excel gratuit - Guide
- Déplacer colonne excel - Guide
- Si ou excel - Guide
5 réponses
bonjour
un essai
- mettre un bouton sur la feuille (boite a outils controles)
- lui affecter ce code
- selectionner la plage a traiter
- clic
bonne suite
un essai
- mettre un bouton sur la feuille (boite a outils controles)
- lui affecter ce code
- selectionner la plage a traiter
- clic
Private Sub CommandButton1_Click()
Dim c As Range
Dim liste As String
liste = ""
For Each c In Selection
If Not (InStr(1, liste, c.Value) > 0) Then
liste = liste & "," & c.Value
End If
Next c
liste = Right(liste, Len(liste) - 1)
MsgBox (liste)
End Sub
bonne suite
En fait ma plage est fixe du type A1:E3, comment dois-je adapter ton code de ce fait ?
Merci pour ton aide
Merci pour ton aide
Grace à un collègue j'ai trouvé la solution :
Private Function InCollection(col As Collection, sKey As String) As Boolean
Dim bTest As Boolean
On Error Resume Next
bTest = IsObject(col(sKey))
If (Err = 0) Then
InCollection = True
Else
Err.Clear
End If
End Function
Function uniquevalues(thecells As Range) As Collection
Dim values As New Collection
For Each thecell In thecells
If Not InCollection(values, thecell.Text) Then
values.Add Item:=thecell.Value, key:=thecell.Text
End If
Next
Set uniquevalues = values
End Function
Sub test()
Set col = uniquevalues(Range("K54: N84"))
End Sub
Private Function InCollection(col As Collection, sKey As String) As Boolean
Dim bTest As Boolean
On Error Resume Next
bTest = IsObject(col(sKey))
If (Err = 0) Then
InCollection = True
Else
Err.Clear
End If
End Function
Function uniquevalues(thecells As Range) As Collection
Dim values As New Collection
For Each thecell In thecells
If Not InCollection(values, thecell.Text) Then
values.Add Item:=thecell.Value, key:=thecell.Text
End If
Next
Set uniquevalues = values
End Function
Sub test()
Set col = uniquevalues(Range("K54: N84"))
End Sub
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Bonjour
à essayer
si tu veux une réponse avec tri dans l'ordre tu dis...
Michel
à essayer
Const lig As Byte = 1 'coordonnées de départ
Const col As Byte = 1
Const nbre_lig As Byte = 3 'surface du tableau
Const nbre_col As Byte = 5
Const adresse As String = "$B$10" 'restitution cellule B10
Sub liste_()
Dim dico As Object
Dim cptr_lig As Byte, cptr_col As Byte
Set dico = CreateObject("scripting.dictionary")
For cptr_lig = lig To nbre_lig + lig
For cptr_col = col To nbre_col + col
ref = Cells(cptr_lig, cptr_col)
If Not IsEmpty(ref) And Not dico.exists(ref) Then
dico.Add ref, ref
End If
Next
Next
Range(adresse) = Join(dico.items, ", ")
End Sub
si tu veux une réponse avec tri dans l'ordre tu dis...
Michel