Pareto VBA excel

1 pièce(s) jointe(s)

Pareto VBA excel

Bonjour,

j'aurais besoin d'aide pour un devoir svp. Je dois concevoir un pareto sur excel mais uniquement avec VBA. Je dois concevoir un graphique Pareto récapitulant les quantités refusées par matières premières (avec leurs noms…) ( feuille "réception matière première"). Cependant, après plusiuers essai je ne vois pas du tout quel code utilier
Pièce jointe 538982

Ceci pourra t'aider : https://silkyroad.developpez.com/excel/pareto/
C'est fait en Excel sans VBA mais tout ce qui est fait en Excel peut être fait en VBA.

Bonjour,

Je vous remercie de votre réponse mais justement je l'ai déjà fait en excel, c'est le faire en VBA que je n'y arrive pas et je dois le réaliser uniquement en VBA.

Citation:

Envoyé par Sarah SO

je n'y arrive pas

C'est un peu court comme description de la difficulté.
Qu'est-ce qui techniquement te bloque ?

Accessoirement, je te conseille la lecture de la règle IV-N du forum : http://club.developpez.com/regles/#LIV-N
Ainsi que celle-ci : https://www.developpez.net/forums/d8...s-discussions/

1 pièce(s) jointe(s)

En faite, j'ai fait un code mais celui-ci ne fonctionne pas et je n'arrive pas à trouver mon erreur.

En faite, j'obtiens un pareto vide.

Visiblement, tu n'as pas bien lu ma réponse #4.

Pour être plus clair, plusieurs intervenants sur ce forum n'ouvrent pas les fichiers joints.
Je te conseille donc de copier ton code dans la réponse et de l'accompagner éventuellement de copies d'écran pour le faire comprendre.

1 pièce(s) jointe(s)

Bonjour,

Effectivement, j'ai mal compris votre réponse.

Voici le code :

Code:

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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
Sub Creation_graph_Pareto_mat_premiere()
 
' Construire le graphique quelque soit le nombre de données
Application.ScreenUpdating = False
'version 1 sans prise en compte date début et fin par l'utilisateur
 
'Declaration des variables
    'declaration de variables inconnues
 
Dim Int_Col_Abcisse As Integer
    'declaration compteurs
Dim Int_Compteur_x As Integer ' variable de compteur pour boucles utilitaires en x
Dim Si_Compteur_y As Single ' variable de compteur pour boucles utilitaires en x
Dim Si_Compteur_Non_Conformites_totales As Single
Dim Int_Compteur_Empty_x As Integer 'nombre de cellules vides dans une ligne
Dim Si_Compteur_Fournisseur_Tampon As Single 'compteur pour scan vertical fournisseurs dans feuille tampon
Dim Si_Compteur_y_Code_Mat As Single
 
    'declaration variables tableaux
Dim Si_Xtab_Donnees As Single 'x tableau de donnees
Dim Si_Ytab_Donnees As Single 'y tableau de donnees
    'declaration element graphe
Dim St_Nom_Graphe As String
Dim St_Nom_Feuille_Graphe As String
Dim St_Abscisse As String
Dim St_donnees_source_graphe As String
Dim Int_L_Fin As Integer
Dim Int_L_Debut As Integer
Dim Si_L_Fin_Mat_Premiere As Single
Dim Int_Total_NC As Integer
Dim St_Nom_Abcisse_graphe As String
Dim St_Nom_Ordonnees_graphe As String
Dim St_Nom_Feuille_Code_Mat As String
Dim int_derniere_ligne As Double
 
    'declaration donnees generales
Dim St_Nom_Classeur As String
Dim St_Nom_Feuille_Donnees As String
    'declaration variables pour traitement
Dim Boo_Sortie As Boolean
Dim Boo_Fournisseur_trouve  As Boolean
 
 
'declaration des constantes
Const St_Nom_Feuille_Tampon As String = "Tampon_Pareto"
Const Si_Lim_Fin_Boucle_y As Single = 1048576 ' 1048576on utilise des boucles for avec une limite elevee pour eviter les boucles while. La limite est arbitraire et correspond au nombre de lignes maximum d'une feuille excel
Const Int_Lim_Fin_Boucle_x As Integer = 7 'lim correspondant au nombre de colonnes utlises a chaque ligne dans le tableau
Const Int_Num_Col_Refusee As Integer = 7 'la caracteristique refusee est a la 7 eme colonne actuellement
Const Int_Num_Col_Matiere_Premiere As Integer = 2 'la caracteristique refusee est a la 7 eme colonne actuellement
 
 
'declaration tableaux de traitement
Dim Tab_Recuperation_Des_Donnees() As Variant 'utilisation de tableaux virtuels pour un temps de traitement environ 20 fois plus rapide qu une methode conventionnelle
Dim Tab_Synthese_Des_Donnees() As Variant
 
'recherche de la derniere ligne non vide
int_derniere_ligne = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
 
'initialisation des variables
St_Nom_Graphe = "Quantité refusée par Matières Premières"
St_Nom_Feuille_Graphe = "Graphique de pareto"
St_Nom_Classeur = ActiveWorkbook.Name 'recupération nom classeur
St_Nom_Feuille_Donnees = Workbooks(St_Nom_Classeur).ActiveSheet.Name 'recuperation nom feuille (feuille sur laquelle est mis le bouton de lancement de la macro)
    'variable tampon pour traitement
Boo_Sortie = False
Boo_Fournisseur_trouve = False
    'initialisation total de nc
Int_Total_NC = 0
    'attribution nom feuille mat premiere
St_Nom_Feuille_Code_Mat = "Mat°1°"
    'initialisation fin ligne mat premiere
For Si_Compteur_y = 2 To Si_Lim_Fin_Boucle_y
    If IsEmpty(Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Code_Mat).Cells(Si_Compteur_y, 1).Value) Then
        Si_L_Fin_Mat_Premiere = Si_Compteur_y
        Exit For
    End If
Next Si_Compteur_y
 
 
    'remise a zero feuille tampon
Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Activate
Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Range(Cells(2, 1), Cells(Si_Lim_Fin_Boucle_y, 8)).ClearContents
 
 
 
    'initialisation variables creation graphe
Int_L_Debut = 2 'debut des variables a placer dans le graphique
Int_Col_Abcisse = 5 'colonne correspondant aux categories
 
 
'Recuperation donnees de synthese dans le tableau de synthese
Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Activate
Tab_Synthese_Des_Donnees = Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Range(Cells(1, 1), Cells(int_derniere_ligne, 3)).Value
'recuperation donnees a traiter dans tableau de  traitement
Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Donnees).Activate
Tab_Recuperation_Des_Donnees = Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Donnees).Range(Cells(1, 1), Cells(int_derniere_ligne, Int_Lim_Fin_Boucle_x)).Value
 
'attribution des noms des axes
St_Nom_Abcisse_graphe = Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Code_Mat).Cells(1, 2).Value
St_Nom_Ordonnees_graphe = "Quantité refusée"
 
'Synthese des donnees pour le pareto
    'boucle de scan vertical
For Si_Compteur_y = 2 To int_derniere_ligne
    'verification si scan arrivee a la fin des donnees
    Int_Compteur_Empty_x = 0 ' reinitialisation compteur de cellules  vides
    ' boucle de scan horizontal
    For Int_Compteur_x = 1 To Int_Lim_Fin_Boucle_x
            If Tab_Recuperation_Des_Donnees(Si_Compteur_y, Int_Compteur_x) = "" Then 'si aucun element detecte
                Int_Compteur_Empty_x = Int_Compteur_Empty_x + 1         ' incrementation compteur cellule vide
                'MsgBox " cellule vide en " & "Y : " & Si_Compteur_y & " X : " & Int_Compteur_x
                If Int_Compteur_Empty_x = Int_Lim_Fin_Boucle_x Then     ' si toute les cellules de la lignes sont vides
                    Boo_Sortie = True
                    Exit For ' on a fini le scan des donnees donc on quitte la boucle de recuperation des donnees
                End If
            End If
    Next Int_Compteur_x
    If Int_Compteur_Empty_x <> 0 Then ' action quand detection erreur de remplissage sur une des colonnes
    End If
    If Boo_Sortie = True Then Exit For ' si on a atteint la fin des lignes utilisees on sort de la boucle
 
    Boo_Fournisseur_trouve = False ' reinitialisation variable tampon fournisseur found
    'verification si presence non conformite
    If Tab_Recuperation_Des_Donnees(Si_Compteur_y, Int_Num_Col_Refusee) = "VRAI" Then
        'verification si code fournisseur deja present dans feuille tampon
        For Si_Compteur_Fournisseur_Tampon = 2 To Si_Lim_Fin_Boucle_y 'scan vertical
            If Tab_Synthese_Des_Donnees(Si_Compteur_Fournisseur_Tampon, 1) = "" Then Exit For 'si fin des donnees en tampon alors on arrete la recherche
            'test si correspondance entre code fournisseur et celui de la base de donnee
            If Tab_Recuperation_Des_Donnees(Si_Compteur_y, Int_Num_Col_Matiere_Premiere) = Tab_Synthese_Des_Donnees(Si_Compteur_Fournisseur_Tampon, 1) Then
                Tab_Synthese_Des_Donnees(Si_Compteur_Fournisseur_Tampon, 2) = Tab_Synthese_Des_Donnees(Si_Compteur_Fournisseur_Tampon, 2) + Tab_Recuperation_Des_Donnees(Si_Compteur_y, 5) 'incrementation du nb de non conformites
                Boo_Fournisseur_trouve = True
                Exit For
            End If
        Next Si_Compteur_Fournisseur_Tampon
        If Boo_Fournisseur_trouve = False Then ' si le fournisseur n est pas deja enregistre alors on l enregistre dans une nouvelle categorie
            Tab_Synthese_Des_Donnees(Si_Compteur_Fournisseur_Tampon, 1) = Tab_Recuperation_Des_Donnees(Si_Compteur_y, Int_Num_Col_Matiere_Premiere)
            Tab_Synthese_Des_Donnees(Si_Compteur_Fournisseur_Tampon, 2) = Tab_Recuperation_Des_Donnees(Si_Compteur_y, 5)
        End If
    End If
  Next Si_Compteur_y
'affichage synthese des donnees dans feuille tampon
Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Activate
Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Range(Cells(1, 1), Cells(Si_Lim_Fin_Boucle_y, 3)).Value = Tab_Synthese_Des_Donnees
 
 
 
'Creation graphe pareto
'obtention dernière ligne des donnees
For Si_Compteur_y = 2 To Si_Lim_Fin_Boucle_y
    If IsEmpty(Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Cells(Si_Compteur_y, 1)) = True Then Exit For
Next Si_Compteur_y
Int_L_Fin = Si_Compteur_y - 1
 
'copie des donnees
    'on place les nouvelles donnees
Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Activate
Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Range(Cells(1, 1), Cells(Int_L_Fin, 2)).Copy Destination:=Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Range(Cells(1, 5), Cells(Int_L_Fin, 6))
 
 
    'remplacement des codes matiere par les nom des matières premières
For Si_Compteur_y = 2 To Int_L_Fin
 
    For Si_Compteur_y_Code_Mat = 2 To Si_L_Fin_Mat_Premiere
    If Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Cells(Si_Compteur_y, 5).Value = Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Code_Mat).Cells(Si_Compteur_y_Code_Mat, 1).Value Then
        Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Cells(Si_Compteur_y, 5).Value = Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Code_Mat).Cells(Si_Compteur_y_Code_Mat, 2).Value
    End If
    Next Si_Compteur_y_Code_Mat
Next Si_Compteur_y
 
 
 
'tri des donnees
Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Range(Cells(2, 5), Cells(Int_L_Fin, 6)).Select
ActiveWorkbook.Worksheets(St_Nom_Feuille_Tampon).Range("E1:G" & Int_L_Fin).Sort key1:=Range("F2:F" & Int_L_Fin), Order1:=xlDescending
'    ActiveWorkbook.Worksheets(St_Nom_Feuille_Tampon).Sort.SortFields.Add Key:=Range( _
'        "F2:F" & Int_L_Fin), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
'        xlSortNormal
'    With Workbooks(St_Nom_Classeur).Worksheets(St_Nom_Feuille_Tampon).Sort
'        .SetRange Range("E1:G" & Int_L_Fin)
'        .Header = xlYes
'        .MatchCase = False
'        .Orientation = xlTopToBottom
'        .SortMethod = xlPinYin
'        .Apply
'    End With
 
'recuperation total de nc
For Si_Compteur_y = 2 To Int_L_Fin
    Int_Total_NC = Int_Total_NC + Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Cells(Si_Compteur_y, 6).Value
Next Si_Compteur_y
 
 
For Si_Compteur_y = 2 To Int_L_Fin
    If Si_Compteur_y = 2 Then ' non prise en compte val precedente dans le cas de la premiere valeur
        Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Cells(Si_Compteur_y, 7).Value = Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Cells(Si_Compteur_y, 6).Value / Int_Total_NC
    Else
    Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Cells(Si_Compteur_y, 7).Value = Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Cells(Si_Compteur_y - 1, 7).Value + Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Cells(Si_Compteur_y, 6).Value / Int_Total_NC
    End If
    Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Cells(Si_Compteur_y, 7).Style = "Percent"
Next Si_Compteur_y
 
    'utilisation de la feuille St_Nom_Feuille_Tampon
St_Abscisse = "=" & St_Nom_Feuille_Tampon & "!R" & Int_L_Debut & "C" & Int_Col_Abcisse & ":R" & Int_L_Fin & "C" & Int_Col_Abcisse
St_donnees_source_graphe = "F1:G" & Int_L_Fin
 
'si le graph existe, on le supprime
For Int_Compteur_x = 1 To Sheets.Count
'Sheets(Int_Compteur_x).Activate
If Sheets(Int_Compteur_x).Name = St_Nom_Feuille_Graphe Then
        On Error GoTo Continuer
 
        Application.DisplayAlerts = False 'desactivation alerte windows
        Sheets(Int_Compteur_x).Delete   'détruit la feuille créée
        Application.DisplayAlerts = True
End If
Next Int_Compteur_x
Continuer:
 
Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Activate
Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Range(Cells(2, 5), Cells(Int_L_Fin, 7)).Select
Workbooks(St_Nom_Classeur).Sheets(St_Nom_Feuille_Tampon).Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range(St_donnees_source_graphe)
ActiveChart.ChartType = xlColumnClustered
 
ActiveChart.Location Where:=xlLocationAsNewSheet
ActiveSheet.Name = St_Nom_Feuille_Graphe
Sheets(St_Nom_Feuille_Graphe).Move after:=Sheets(St_Nom_Feuille_Donnees)
 
ActiveChart.SeriesCollection(1).XValues = "='" & St_Nom_Feuille_Tampon & "'!$E$2:$E$" & Int_L_Fin 'utlisation des abscisses
ActiveChart.SeriesCollection(2).Select
ActiveChart.SeriesCollection(2).AxisGroup = 2
ActiveChart.SeriesCollection(2).Select
ActiveChart.SeriesCollection(2).ChartType = xlLineMarkers
 
ActiveChart.Axes(xlValue, xlSecondary).Select
ActiveChart.Axes(xlValue, xlSecondary).MaximumScale = 1
 
ActiveChart.ApplyLayout (5) 'afficher les valeurs sous le graphique
ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Text = "Quantité refusée par Matières Premières"
'creation et ajustement position axe ordonnees
ActiveChart.Axes(xlValue).AxisTitle.Select
ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Text = St_Nom_Ordonnees_graphe
ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Orientation = xlHorizontal
ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Font.Size = 14
Selection.Left = 35
Selection.Top = 15
'creation et ajustement position axe abcisses
ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
ActiveChart.Axes(xlCategory).AxisTitle.Select
ActiveChart.Axes(xlCategory, xlPrimary).AxisTitle.Text = St_Nom_Abcisse_graphe
ActiveChart.Axes(xlCategory, xlPrimary).AxisTitle.Font.Size = 14
Selection.Left = 22
Selection.Top = 392
 
Sheets(St_Nom_Feuille_Graphe).Select
ActiveChart.ChartArea.Select
 
Application.ScreenUpdating = True
End Sub

Quand je parlais de copie d'écran, je ne parlais pas du code mais de la feuille de calcul pour savoir comment sont organisées tes données.
Quand tu postes un code, place-le entre balises CODE (l'icone #) parce que, copier comme ça, il est difficilement lisible.

Tout ceci ressemble à un code que tu aurais récupéré quelque part et que tu aurais essayé d'exécuter sans chercher à le comprendre et à l'adapter à ta structure de données.
Ca expliquerait pourquoi tu obtiens un résultat "vide".

1 pièce(s) jointe(s)

Nous avons réalisé ce code par groupe donc non nous ne l'avons pas récupérer.