CommentRécupérer 1 liste de valeur sous excel
Résolu/Fermé
braguy13
-
5 janv. 2011 à 10:25
Zoul67 Messages postés 1959 Date d'inscription lundi 3 mai 2010 Statut Membre Dernière intervention 30 janvier 2023 - 7 janv. 2011 à 19:50
Zoul67 Messages postés 1959 Date d'inscription lundi 3 mai 2010 Statut Membre Dernière intervention 30 janvier 2023 - 7 janv. 2011 à 19:50
A voir également:
- CommentRécupérer 1 liste de valeur sous excel
- Liste déroulante excel - Guide
- Formule excel - Guide
- Excel liste déroulante en cascade - Guide
- Si et excel - Guide
- Aller à la ligne excel - Guide
5 réponses
ccm81
Messages postés
10850
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
27 mars 2024
2 404
Modifié par ccm81 le 5/01/2011 à 10:44
Modifié par ccm81 le 5/01/2011 à 10:44
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
ccm81
Messages postés
10850
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
27 mars 2024
2 404
5 janv. 2011 à 10:57
5 janv. 2011 à 10:57
re
For Each c In Range("A1:E3")
bonne suite
For Each c In Range("A1:E3")
bonne suite
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
Zoul67
Messages postés
1959
Date d'inscription
lundi 3 mai 2010
Statut
Membre
Dernière intervention
30 janvier 2023
149
6 janv. 2011 à 00:10
6 janv. 2011 à 00:10
Il faut effectivement utiliser des Collections pour faire des listes sans doublons.
Merci d'indiquer le sujet comme "résolu".
Merci d'indiquer le sujet comme "résolu".
michel_m
Messages postés
16603
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 décembre 2023
3 303
Modifié par michel_m le 6/01/2011 à 09:30
Modifié par michel_m le 6/01/2011 à 09:30
Il n'a y a pas que les collections: Elles sont particulièrement lentes par les activations et désactivations incessantes du gestionnaire d'erreur...
Ca nivelle par le bas en ce début d'année sur CCM.
Ca nivelle par le bas en ce début d'année sur CCM.
Zoul67
Messages postés
1959
Date d'inscription
lundi 3 mai 2010
Statut
Membre
Dernière intervention
30 janvier 2023
149
7 janv. 2011 à 19:50
7 janv. 2011 à 19:50
Soit... on peut utiliser des Collections. Pour le nivellement, on fait ce qu'on peut...
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
michel_m
Messages postés
16603
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 décembre 2023
3 303
Modifié par michel_m le 5/01/2011 à 12:45
Modifié par michel_m le 5/01/2011 à 12:45
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
