Discussion :

[Nyck0las]

Bonjour,

Je suis en train de travailler sur une base de données et je voudrais réaliser un userform qui me permettrait de sélectionner l'élément qui servira de référence dans la suite de mon étude.

En gros pour choisir cette référence, il me faut croiser 3 colonnes
- nom
- année
- domaine
Il peut y avoir des redondances (un même nom à diverses années et pour divers domaines)

En gros ce que je souhaiterais faire, ce sont 3 listbox qui reprendrais ces 3 colonnes nom, domaine et année, sans doublon, classée par ordra alphanumériqueet quand je sélectionne un élement d'une colonne celà enlève des choix dans les autres.
Cà correspond en fait aux filtres automatiques sur ces 3 colonnes, mais je souhaite une méthode détournée pour que l'utilisateur n'ait pas accès à la base de données directement.

Est-ce que quelqu'un aurait une petite piste ?

[House MD]

Bonjour,

Ta base de données, c'est ?

[House MD]

Pardon, j'avais pas bien lu l'intitulé...

Si c'est excel, il te suffit de trier chaque colonne une par une via "range.sort".

Puis d'ajouter à ta PREMIERE listbox chaque élément dédoublonné via une méthode de type :

dim str as string

for A=premiereligne to derniereligne
if iserror(application.match(.cells(A,1),range(.cells(A+1,1),.cells(dernièreligne,1)),0)) then mylistbox1.additem .cells(A,1)

next A

Ca c'est pour la première listbox, dans le form1.initialize (si tu es dans un userform, mais tu peux l'adaoter si tu es dans Excel)

Pour la 2eme listbox, tu fais un filtre en fonction de l'élément sélectionné dans la premère :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
Private sub mylistbox1_Change()
 
for A=premiereligne to derniereligne
  if .cells(A,1)=mylistbox1.text then mylistbox2. additem .cells(A,2)
next A
 
end sub

Puis pour ta 3eme listbox :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private sub mylistbox2_Change()
 
for A=premiereligne to derniereligne
  if .cells(A,1)=mylistbox1.text and .cells(A,2)=mylistbox2.text then mylistbox3. additem .cells(A,3)
next A
 
end sub

A adapter, c'est juste un schéma général.

[Nyck0las]

J’ai trouvé la solution à mon pb sur le site :
http://silkyroad.developpez.com/VBA/...serForm/#LII-C

et voici le résultat :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
 Private Sub userform_initialize()
 
    'codage des noms des champs dynamiques
    ActiveWorkbook.Names.Add Name:="An", RefersTo:="=OFFSET(Cells(2,ColA),,,CountA((" & Columns(ColA).Address & ") - 1)"
    ActiveWorkbook.Names.Add Name:="Collectivité", RefersTo:="=OFFSET(Cells(2,ColC),,,CountA(" & Columns(ColC).Address & ") - 1)"
    ActiveWorkbook.Names.Add Name:="Domaine", RefersTo:="=OFFSET(Cells(2,ColD),,,CountA(" & Columns(ColD).Address & ") - 1)"
 
    Ch_Nom
    Ch_An
    Ch_Domaine
    On Error Resume Next
    ActiveSheet.ShowAllData
 
End Sub
 
Private Sub Collectivité_DropButtonClick()
    Ch_Nom
End Sub
 
Private Sub Domaine_DropButtonClick()
    Ch_Domaine
End Sub
 
Private Sub An_DropButtonClick()
    Ch_An
End Sub
 
Private Sub An_Change()
    filtre
End Sub
 
Private Sub Domaine_Change()
    filtre
End Sub
 
Private Sub Collectivité_Change()
    filtre
End Sub
 
Sub Ch_Nom()
    Set MonDico = CreateObject("Scripting.Dictionary")
    For i = 1 To Range("Collectivité").Count
        If Range("Domaine")(i) Like Me.Domaine And CStr(Range("An")(i)) Like Me.An Then
            temp = Range("Collectivité")(i)
            If Not MonDico.Exists(temp) Then
                MonDico.Add temp, temp
            End If
        End If
    Next i
    MonDico.Add "*", "*"
    temp = MonDico.items
    Call Tri(temp, LBound(temp), UBound(temp))
    Me.Collectivité.list = temp
End Sub
 
Sub Ch_An()
    Set MonDico = CreateObject("Scripting.Dictionary")
    For i = 1 To Range("An").Count
        If Range("Collectivité")(i) Like Me.Collectivité And Range("Domaine")(i) Like Me.Domaine Then
            temp = Range("An")(i)
            If Not MonDico.Exists(temp) Then
                MonDico.Add temp, temp
            End If
        End If
    Next i
    MonDico.Add "*", "*"
    temp = MonDico.items
    Call Tri(temp, LBound(temp), UBound(temp))
    Me.An.list = temp
End Sub
 
Sub Ch_Domaine()
    Set MonDico = CreateObject("Scripting.Dictionary")
    For i = 1 To Range("Domaine").Count
        If Range("Collectivité")(i) Like Me.Collectivité And CStr(Range("An")(i)) Like Me.An Then
            temp = Range("Domaine")(i)
            If Not MonDico.Exists(temp) Then
                MonDico.Add temp, temp
            End If
        End If
    Next i
    MonDico.Add "*", "*"
    temp = MonDico.items
    Call Tri(temp, LBound(temp), UBound(temp))
    Me.Domaine.list = temp
End Sub
 
Sub Tri(a, gauc, droi) ' Quick sort
    Ref = CStr(a((gauc + droi) \ 2))
    g = gauc: d = droi
    Do
        Do While CStr(a(g)) < Ref: g = g + 1: Loop
        Do While Ref < CStr(a(d)): d = d - 1: Loop
        If g <= d Then
            temp = a(g): a(g) = a(d): a(d) = temp
            g = g + 1: d = d - 1
        End If
    Loop While g <= d
    If g < droi Then Call Tri(a, g, droi)
    If gauc < d Then Call Tri(a, gauc, d)
End Sub
 
Sub filtre()
    Dim Cellule
    Cellule = Cells(1, ColP)
    On Error Resume Next
    ActiveSheet.ShowAllData
    Cellule.AutoFilter Field:=1, Criteria1:=Me.Collectivité
    If Me.An <> "*" Then Cellule.AutoFilter Field:=3, Criteria1:=Me.An
    Cellule.AutoFilter Field:=2, Criteria1:=Me.Domaine
End Sub
 
Private Sub B_OK_Click()
    CollectR = Me.Collectivité
    DomR = Me.Domaine
    AnR = Me.An
    Call LigneRef
    ActiveSheet.ShowAllData
    Unload ChxRef
End Sub
 
Sub LigneRef()
    Dim ligne As Integer
    If Range("A:A").SpecialCells(xlCellTypeVisible).Areas(1).Count > 1 Then
        ligne = 2        'pas de filtre
    Else                 'il y a un filtre
        ligne = Range("A:A").SpecialCells(xlCellTypeVisible).Areas(2).Item(1).Row
    End If
    LgR = ligne
End Sub

mais par contre j’ai un problème maintenant pour nommer mes champs dynamiques car je ne sais pas à l’avance que la plage nommé An sera dans la colonne C. Ce que j’ai marqué dans le code ci-dessus ne marche pas et me provoque l’erreur d’exécution 1004
Il faudrait donc pouvoir nommer le champ avec un nom de colonne variable, mais je ne sais pas comment faire …

La syntaxe basique est la suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 ActiveWorkbook.Names.Add Name:="An", RefersTo:="=OFFSET($C$2,,,CountA($C:$C) - 1)"

[ouskel'n'or]

Je crois me souvenir que pour utiliser un nom existant dans une feuille de calculs tu dois d'abord le supprimer (j'ai utilisé ça mais c'est vieux ) Tu peux toujours tester. Ensuite, tu dois désigner la feuille pour indiquer une colonne ou une cellule. Et là je ne vois pas où c'est fait

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

RefersTo:="=Feuil1!OFFSET(Cells(2,ColD),,,CountA(" & Columns(ColD).Address & ") - 1)"

Ceci dit j'ignore si tu ne dois également le placer devant colonne. A tester