Discussion :

[VBAdudu]

Bonjour le forum,

J’ai besoin de votre aide pour résoudre un problème dont je n’ai pas la solution (malheureusement). J’ai des bases en VBA et je me débrouille jusqu’à un certain niveau.
Maintenant je me retrouve face aux « zones de liste » (ListBox) que je ne sais pas utiliser dans une macro.

Pour mieux comprendre, vous trouverez en pièce jointe un fichier modèle (« ListBox test »).

Mon objectif est d’obtenir le nombre d’effectifs au 31 janvier 2018 par grade grâce aux infos dans l’onglet « base 31082018 » ET en utilisant LA LISTE DE VALIDATION (« pole1 ») et les ZONES DE LISTE => Contrat + Actif Suspendu + Expatrié.

Pour être plus précis, j’aimerais par exemple, sélectionner le pôle puis le(s) contrat(s) puis si actif ou suspendu ou tous puis si expatrié ou pas ou tous et ainsi afficher le nombre qui correspond par grade dans le tableau en bas de l’onglet « Recherche » grâce à l’onglet « Base 31082018 ».

J’ai réussi à faire cela sans VBA avec que des LISTES DE VALIDATION et des formules énormes (If, countif etc.) dans le tableau des effectifs. Mais cela ne me permet pas de sélectionner plusieurs contrats par exemple, donc je souhaite travailler avec les « zones de liste ».

Pourriez-vous m’aider à résoudre ce problème ?

Je reste à votre disposition si nécessaire et vous remercie par avance pour le temps que vous m’accordez.

Cordialement


ListBox Test.xlsx

[boisgontierjacques]

Bonsoir,

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
Private Sub UserForm_Initialize()
  NomTableau = "Tableau1"
  TblBD = Range(NomTableau).Value
  NbCol = UBound(TblBD, 2)
  Set d = CreateObject("scripting.dictionary")
  For i = LBound(TblBD) To UBound(TblBD)
    d(TblBD(i, 5)) = ""
  Next i
  Me.ChoixListBox1.List = d.keys
  For i = 1 To d.Count: Me.ListBox1.Selected(i) = False: Next i
 
  Set d = CreateObject("scripting.dictionary")
  For i = LBound(TblBD) To UBound(TblBD)
    d(TblBD(i, 6)) = ""
  Next i
  Me.ChoixListBox2.List = d.keys
 
  Set d = CreateObject("scripting.dictionary")
  d.comparemode = vbTextCompare
  For i = LBound(TblBD) To UBound(TblBD)
    d(TblBD(i, 7)) = ""
  Next i
  Me.ChoixListBox3.List = d.keys
 
  Me.ListBox1.ColumnCount = NbCol
  Me.ListBox1.List = TblBD
  EnteteListBox
End Sub
 
Sub EnteteListBox()
   x = Me.ListBox1.Left + 8
   Y = Me.ListBox1.Top - 20
   For c = 1 To NbCol
       Set Lab = Me.Controls.Add("Forms.Label.1")
       Lab.Caption = Range(NomTableau).Offset(-1).Item(1, c)
       Lab.ForeColor = vbBlack
       Lab.Top = Y
       Lab.Left = x
       Lab.Height = 24
       Lab.Width = Range(NomTableau).Columns(c).Width * 1#
       x = x + Range(NomTableau).Columns(c).Width * 1
       tempcol = tempcol & Range(NomTableau).Columns(c).Width * 1# & ";"
   Next c
   tempcol = tempcol
   On Error Resume Next
   Me.ListBox1.ColumnWidths = tempcol
   On Error GoTo 0
End Sub
Private Sub ChoixListBox1_change()
  Affiche
End Sub
Private Sub ChoixListBox2_change()
  Affiche
End Sub
Private Sub ChoixListBox3_change()
  Affiche
End Sub
Sub Affiche()
  Set dchoisis1 = CreateObject("Scripting.Dictionary")
  For i = 0 To Me.ChoixListBox1.ListCount - 1
    If Me.ChoixListBox1.Selected(i) Then dchoisis1(Me.ChoixListBox1.List(i, 0)) = ""
  Next i
  Set dchoisis2 = CreateObject("Scripting.Dictionary")
  For i = 0 To Me.ChoixListBox2.ListCount - 1
    If Me.ChoixListBox2.Selected(i) Then dchoisis2(Me.ChoixListBox2.List(i, 0)) = ""
  Next i
  Set dchoisis3 = CreateObject("Scripting.Dictionary")
  For i = 0 To Me.ChoixListBox3.ListCount - 1
    If Me.ChoixListBox3.Selected(i) Then dchoisis3(Me.ChoixListBox3.List(i, 0)) = ""
  Next i
  n = 0: Dim Liste()
  For i = LBound(TblBD) To UBound(TblBD)
     tmp = TblBD(i, 5)
     tmp2 = TblBD(i, 6)
     tmp3 = TblBD(i, 7)
     If (dchoisis1.exists(tmp) Or dchoisis1.Count = 0) _
        And (dchoisis2.exists(tmp2) Or dchoisis2.Count = 0) _
          And (dchoisis3.exists(tmp3) Or dchoisis3.Count = 0) Then
         n = n + 1
         ReDim Preserve Liste(1 To NbCol, 1 To n)
         For k = 1 To NbCol
            Liste(k, n) = TblBD(i, k)
         Next k
     End If
  Next i
  If n > 0 Then Me.ListBox1.Column = Liste Else Me.ListBox1.Clear
End Sub

Boisgontier

[VBAdudu]

Bonjour,

Merci pour votre retour ! Le résultat est génial ! Je vais étudier le code en détail pour mieux comprendre et apprendre davantage sur le VBA.

Mais avec cette solution il est possible de « visualiser » les infos, mais moi j’aurais besoin d’avoir un chiffre par rapport aux filtres sélectionnés. C’est pour cette raison que j’ai un tableau que j’aimerais compléter.

Est-il possible de rajouter un «nbr.si »/ « countif » qui va faire apparaitre le nombre d’effectifs par grade ? que ce soit dans le USERFORME ou directement sur une feuille excel ?

Exemple :



Dans l’exemple ci-dessus on aurait :
1A : 3
3V : 0
4R : 0
6N : 0
9P : 3

Merci beaucoup pour votre aide et le temps que vous m'accordez!

cordialement

[boisgontierjacques]

Bonjour,

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
Dim f, NbCol, NomTableau, TblBD()
 
Private Sub UserForm_Initialize()
  NomTableau = "Tableau1"
  TblBD = Range(NomTableau).Value
  NbCol = UBound(TblBD, 2)
  Set d = CreateObject("scripting.dictionary")
  For i = LBound(TblBD) To UBound(TblBD)
    d(TblBD(i, 5)) = ""
  Next i
  Me.ChoixListBox1.List = d.keys
  For i = 1 To d.Count: Me.ListBox1.Selected(i) = False: Next i
 
  Set d = CreateObject("scripting.dictionary")
  For i = LBound(TblBD) To UBound(TblBD)
    d(TblBD(i, 6)) = ""
  Next i
  Me.ChoixListBox2.List = d.keys
 
  Set d = CreateObject("scripting.dictionary")
  d.comparemode = vbTextCompare
  For i = LBound(TblBD) To UBound(TblBD)
    d(TblBD(i, 7)) = ""
  Next i
  Me.ChoixListBox3.List = d.keys
 
  Me.ListBox1.ColumnCount = NbCol
  Me.ListBox1.List = TblBD
  EnteteListBox
End Sub
 
Sub EnteteListBox()
   x = Me.ListBox1.Left + 8
   Y = Me.ListBox1.Top - 20
   For c = 1 To NbCol
       Set Lab = Me.Controls.Add("Forms.Label.1")
       Lab.Caption = Range(NomTableau).Offset(-1).Item(1, c)
       Lab.ForeColor = vbBlack
       Lab.Top = Y
       Lab.Left = x
       Lab.Height = 24
       Lab.Width = Range(NomTableau).Columns(c).Width * 1#
       x = x + Range(NomTableau).Columns(c).Width * 1
       tempcol = tempcol & Range(NomTableau).Columns(c).Width * 1# & ";"
   Next c
   tempcol = tempcol
   On Error Resume Next
   Me.ListBox1.ColumnWidths = tempcol
   On Error GoTo 0
End Sub
Private Sub ChoixListBox1_change()
  Affiche
End Sub
Private Sub ChoixListBox2_change()
  Affiche
End Sub
Private Sub ChoixListBox3_change()
  Affiche
End Sub
Sub Affiche()
  Set dchoisis1 = CreateObject("Scripting.Dictionary")
  For i = 0 To Me.ChoixListBox1.ListCount - 1
    If Me.ChoixListBox1.Selected(i) Then dchoisis1(Me.ChoixListBox1.List(i, 0)) = ""
  Next i
  Set dchoisis2 = CreateObject("Scripting.Dictionary")
  For i = 0 To Me.ChoixListBox2.ListCount - 1
    If Me.ChoixListBox2.Selected(i) Then dchoisis2(Me.ChoixListBox2.List(i, 0)) = ""
  Next i
  Set dchoisis3 = CreateObject("Scripting.Dictionary")
  For i = 0 To Me.ChoixListBox3.ListCount - 1
    If Me.ChoixListBox3.Selected(i) Then dchoisis3(Me.ChoixListBox3.List(i, 0)) = ""
  Next i
  n = 0: Dim Liste()
  Set dsynthese = CreateObject("scripting.dictionary")
  For i = LBound(TblBD) To UBound(TblBD)
     tmp = TblBD(i, 5)
     tmp2 = TblBD(i, 6)
     tmp3 = TblBD(i, 7)
     If (dchoisis1.exists(tmp) Or dchoisis1.Count = 0) _
        And (dchoisis2.exists(tmp2) Or dchoisis2.Count = 0) _
          And (dchoisis3.exists(tmp3) Or dchoisis3.Count = 0) Then
         n = n + 1
         ReDim Preserve Liste(1 To NbCol, 1 To n)
         For k = 1 To NbCol: Liste(k, n) = TblBD(i, k): Next k
         dsynthese(TblBD(i, 8)) = dsynthese(TblBD(i, 8)) + 1
     End If
  Next i
  If n > 0 Then
    Me.ListBox1.Column = Liste
    Me.ListSynthese.Clear
    j = 0
    For Each c In dsynthese
      Me.ListSynthese.AddItem c
      Me.ListSynthese.List(j, 1) = dsynthese(c)
      j = j + 1
    Next c
  Else
    Me.ListBox1.Clear
    Me.ListSynthese.Clear
  End If
End Sub
 
Private Sub B_result_Click()
  Set f = Sheets("result")
  f.[A2:B10].ClearContents
  f.[A2].Resize(Me.ListSynthese.ListCount, 2) = Me.ListSynthese.List
 
  f.[D2:D10].ClearContents
  ligne = 2
  For i = 0 To Me.ChoixListBox1.ListCount - 1
   If Me.ChoixListBox1.Selected(i) Then f.Cells(ligne, "D") = ChoixListBox1.List(i): ligne = ligne + 1
  Next i
 
  f.[E2:E10].ClearContents
  ligne = 2
  For i = 0 To Me.ChoixListBox2.ListCount - 1
   If Me.ChoixListBox2.Selected(i) Then f.Cells(ligne, "E") = ChoixListBox2.List(i): ligne = ligne + 1
  Next i
 
  f.[F2:F10].ClearContents
  ligne = 2
  For i = 0 To Me.ChoixListBox3.ListCount - 1
   If Me.ChoixListBox3.Selected(i) Then f.Cells(ligne, "F") = ChoixListBox3.List(i): ligne = ligne + 1
  Next i
End Sub

Boisgontier

[VBAdudu]

Bonsoir !

Merci énormément pour votre aide ! Le résultat est parfait !
Je vais travailler demain sur la macro pour la comprendre et l'appliquer à mon fichier d'origine.

En attendant je ne clôture pas le sujet au cas ou j'aurais besoin encore d'aide.

Un grand merci !

Cordialement,