Compter occurrence d'un Dico

**Florian53** · 03/04/2018, 20h43

Bonjour à tous,

Je suis entrain de réaliser un fichier afin que celui puisse m'extraire des valeurs :

Le 1er Useform "Menu":
- Demande à l'utilisateur sur combien de critère l'extraction doit se faire, les choix vont de 1 à 3 et 0 veut dire toute la catégorie.
Par exemple si "Quantité de Type Machine = 0" alors on extrait tout les valeurs qui correspondent aux "Années" et aux "Provenance".
Une fois le bouton valider appuyer l'Userform2 s'ouvre afin de faire un choix par rapport aux critères choisit.

Code :

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

1
2
3
4
5
6
For i = 1 To 3
    Me.Controls("ComboBox" & i).AddItem "1" ' 1 critère choisi pour la catégorie
    Me.Controls("ComboBox" & i).AddItem "2"  ' 2 critère choisi pour la catégorie
    Me.Controls("ComboBox" & i).AddItem "3" ' 3 critère choisi pour la catégorie
    Me.Controls("ComboBox" & i).AddItem "0"' aucun critère choisi pour la catégorie donc extraction sans prendre en compte cette catégorie
Next i

Le 2eme Useform "Creation":
Le nombre de Combobox affiché dépend du nombre de critère sélectionné dans l'Userform "Menu", si valeur à 0 La Frame en question se masque.

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
Private Sub BtVldcreation_Click()
Dim tabBDD()
Dim i&, annee&
 
Set wsBDD = Worksheets("retour")
Set dicoimputation = CreateObject("Scripting.Dictionary")
 
    With wsBDD
        tabBDD = Range(.Cells(4, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 21))
    End With
 
If NbTypeMachine = 0 Then
NbTypeMachinex = 0
Else
    If NbTypeMachine >= 1 Then
    NbTypeMachinex = NbTypeMachine - 1
    End If
End If
 
If NbAnnee = 0 Then
NbAnneex = 0
Else
    If NbAnnee >= 1 Then
    NbAnneex = NbAnnee - 1
    End If
End If
 
If NbProvenance = 0 Then
NbProvenancex = 0
Else
    If NbProvenance >= 1 Then
    NbProvenancex = NbProvenance - 1
    End If
End If
 
 
'Boucle qui sert à savoir dans quel cas nous nous trouvons afin de prendre en compte le nombre de critère désiré
    For i = 0 To NbTypeMachinex
            For j = 0 To NbAnneex
                    For k = 0 To NbProvenancex
 
                                    If NbTypeMachine = 0 And NbAnnee = 0 Then ' Seul le critère Provenance est renseigné
                                        For ctlBDD = LBound(tabBDD) To UBound(tabBDD)
                                        If (tabBDD(ctlBDD, 6)) = Me.Controls("ComboBox" & 7 + k) Then
                                        If (tabBDD(ctlBDD, 13)) <> "" Then dicoimputation(tabBDD(ctlBDD, 13)) = ""
                                        End If
                                        Next ctlBDD
                                    ElseIf NbProvenance = 0 And NbTypeMachine = 0 Then ' Seul le critère Année est renseigné
                                        For ctlBDD = LBound(tabBDD) To UBound(tabBDD)
                                        annee = Me.Controls("ComboBox" & 4 + j)
                                        If (tabBDD(ctlBDD, 2)) = annee Then
                                        If (tabBDD(ctlBDD, 13)) <> "" Then dicoimputation(tabBDD(ctlBDD, 13)) = ""
                                        End If
                                        Next ctlBDD
                                    ElseIf NbProvenance = 0 And NbAnnee = 0 Then ' Seul le critère Type Machine est renseigné
                                        For ctlBDD = LBound(tabBDD) To UBound(tabBDD)
                                        If (tabBDD(ctlBDD, 1)) = Me.Controls("ComboBox" & 1 + i) Then
                                        If (tabBDD(ctlBDD, 13)) <> "" Then dicoimputation(tabBDD(ctlBDD, 13)) = ""
                                        End If
                                        Next ctlBDD
                                    ElseIf NbTypeMachine = 0 Then ' Seul le critère Type Machine n' est pas renseigné
                                        For ctlBDD = LBound(tabBDD) To UBound(tabBDD)
                                        annee = Me.Controls("ComboBox" & 4 + j)
                                        If (tabBDD(ctlBDD, 2)) = annee And (tabBDD(ctlBDD, 6)) = Me.Controls("ComboBox" & 7 + k) Then
                                        If (tabBDD(ctlBDD, 13)) <> "" Then dicoimputation(tabBDD(ctlBDD, 13)) = ""
                                        End If
                                        Next ctlBDD
                                    ElseIf NbAnnee = 0 Then ' Seul le critère Année n' est pas renseigné
                                        For ctlBDD = LBound(tabBDD) To UBound(tabBDD)
                                        If (tabBDD(ctlBDD, 1)) = Me.Controls("ComboBox" & 1 + i) _
                                        And (tabBDD(ctlBDD, 6)) = Me.Controls("ComboBox" & 7 + k) Then
                                        If (tabBDD(ctlBDD, 13)) <> "" Then dicoimputation(tabBDD(ctlBDD, 13)) = ""
                                        End If
                                        Next ctlBDD
                                    ElseIf NbProvenance = 0 Then ' Seul le critère Provenance n' est pas renseigné
                                        For ctlBDD = LBound(tabBDD) To UBound(tabBDD)
                                        annee = Me.Controls("ComboBox" & 4 + j)
                                        If (tabBDD(ctlBDD, 1)) = Me.Controls("ComboBox" & 1 + i) And (tabBDD(ctlBDD, 2)) = annee Then
                                        If (tabBDD(ctlBDD, 13)) <> "" Then dicoimputation(tabBDD(ctlBDD, 13)) = ""
                                        End If
                                        Next ctlBDD
                                    Else
                                        For ctlBDD = LBound(tabBDD) To UBound(tabBDD) 'Tous les critères sont renseignés
                                        annee = Me.Controls("ComboBox" & 4 + j)
                                        If (tabBDD(ctlBDD, 1)) = Me.Controls("ComboBox" & 1 + i) And (tabBDD(ctlBDD, 2)) = annee _
                                        And (tabBDD(ctlBDD, 6)) = Me.Controls("ComboBox" & 7 + k) Then
                                        If (tabBDD(ctlBDD, 13)) <> "" Then dicoimputation(tabBDD(ctlBDD, 13)) = ""
                                        End If
                                        Next ctlBDD
                                    End If
 
            Next k
        Next j
    Next i
 
    Unload Me
    Sheets.Add.Move After:=Sheets(Sheets.Count)
    Nom = InputBox("Comment souhaitez vous nommer cette feuille?")
    Sheets(Sheets.Count).Name = Nom
  [A2].Resize(dicoimputation.Count) = Application.Transpose(dicoimputation.keys)
 
 
End Sub

Le but étant de lister dans une nouvelle feuille toutes les Imputations qui correspondent aux critères sélectionné précédemment.

Jusque là, ma macro fonctionne et affiche bien la liste des Imputations qui correspondent aux critères sélectionnés par contre je souhaiterais que dans le colonne "B" de la nouvelle feuille s'affiche le nombre d’occurrence de chaque Imputation.

Depuis plusieurs jours je me creuse les méninges sans trouver la solution, avez vous une piste de réflexion ?

En pièce jointe un fichier exemple avec en Feuil le résultat désiré. test dico.xlsm
Merci à vous

**Florian53** · 03/04/2018, 22h04

J'ai essayé d'incrémenter la clé si le nom existe déjà dans le dico, mais quand je colle les résultats, toutes lignes sont la valeur "1". Hors ce n'est pas le cas.

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
                                        For ctlBDD = LBound(tabBDD) To UBound(tabBDD)
                                        annee = Me.Controls("ComboBox" & 4 + j)
                                        x = 1
                                        If (tabBDD(ctlBDD, 1)) = Me.Controls("ComboBox" & 1 + i) And (tabBDD(ctlBDD, 2)) = annee _
                                        And (tabBDD(ctlBDD, 6)) = Me.Controls("ComboBox" & 7 + k) Then
 
                                            If dicoImputation.Exists(tabBDD(ctlBDD, 13)) Then
                                            dicoImputation(tabBDD(ctlBDD, 13)) = x + 1
                                            End If
 
                                        If (tabBDD(ctlBDD, 13)) <> "" Then dicoImputation(tabBDD(ctlBDD, 13)) = x
 
                                        End If
                                        Next ctlBDD
                                    End If

Mon incrémentation doit pas se faire, mais je ne vois pas ou.

Pouvez vous m’éclaircir svp?

Compter occurrence d'un Dico

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager