Discussion :

[Cedrixxx]

Bonjour à toutes et à tous,

J'aimerais faire un Pareto (courbe ABC) automatiquement via VBA pour cela j'ai trouver un tableau dynamique sur le net mais il me faut pour cela copier
La cellule de la colonne B et C qui correspond a la cellule de la colonne AI quand AI et différent de vide et inférieur à 1 (100%) de la feuille listing machine
Le tout serais coller dans une autre feuille (Graph) et si possible du plus petit au plus grand (mais ça à la limite avec un filtre sa se fera sans vba).


Pour l'instant j'ai réussis a faire cela:

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
Option Explicit
 
' constantes à modifier selon ta configuration
' Feuille Source
Const FS = "Listing-machine"
Const lidebFS = 8
Const comacFS = "C"
Const comacFS1 = "B"
Const comacFS2 = "AI"
 
Const coerrFS = "AI"
' Feuille But
Const FB = "Graph"
Const celdebFB = "A20"
Const celdebFB1 = "b20"
Const celdebFB2 = "c20"
 
Dim cptr As Long
' message recherché
 
Const s As Integer = "0"
 
Public Sub Pareto()
Dim liFS As Long, lifinFS As Long
Dim liFS1 As Long, lifinFS1 As Long
Dim liFS2 As Long, lifinFS2 As Long
 
 
 
Dim dico, dico1, dico2 As Object, cle, cle1, cle2 As String, cles, cles1, cles2, nbcles As Long
' dictionnaire des machines en erreur
 
Set dico = CreateObject("scripting.dictionary")
Set dico1 = CreateObject("scripting.dictionary")
Set dico2 = CreateObject("scripting.dictionary")
 
With Sheets(FS)
 
  lifinFS = .Range(comacFS & Rows.Count).End(xlUp).Row
 
 
  For liFS = lidebFS To lifinFS
 
    cptr = cptr + 1
 
    If .Range(coerrFS & liFS).Value > s And .Range(coerrFS & liFS).Value < 1 Then
'   If s <> .Range(coerrFS & liFS).Value And s <> 0 Then
 '  If s = .Range(coerrFS & liFS).Value Then
 
      cle = .Range(comacFS & liFS).Value
      cle1 = .Range(comacFS1 & liFS).Value
      cle2 = .Range(comacFS2 & liFS).Value
 
      'if cle == "" MsgBox('Clé vide ligne '. Afficher ligne et Colonne d'erreur .)
     If (IsEmpty(cle)) Then MsgBox "Vide 1 : Ligne" & liFS & "Colonne " & comacFS
      If (IsEmpty(cle1)) Then MsgBox "Vide 2 : Ligne" & liFS & "Colonne " & comacFS1
      If (IsEmpty(cle2)) Then MsgBox "Vide 3 : Ligne" & liFS & "Colonne " & comacFS2
 
      If (Not dico.exists(cle)) Then dico.Add cle, 1
      If (Not dico1.exists(cle1)) Then dico1.Add cle1, 1
      If (Not dico2.exists(cle2)) Then dico2.Add cle2, 1
 
    End If
 
  Next liFS
 
 
End With
 
nbcles = dico.Count
 
cles = dico.keys
cles1 = dico1.keys
cles2 = dico2.keys
 
' resultat
With Sheets(FB)
 
  .Range(celdebFB).Resize(1000, 1).ClearContents
  .Range(celdebFB).Offset(-1, 0).Value = "Désignation"
  .Range(celdebFB).Resize(nbcles, 1) = Application.Transpose(cles)
 
  .Range(celdebFB1).Resize(1000, 1).ClearContents
  .Range(celdebFB1).Offset(-1, 0).Value = "N°Machine"
  .Range(celdebFB1).Resize(nbcles, 1) = Application.Transpose(cles1)
 
  .Range(celdebFB2).Resize(1000, 1).ClearContents
  .Range(celdebFB2).Offset(-1, 0).Value = "DI"
  .Range(celdebFB2).Resize(nbcles, 1) = Application.Transpose(cles2)
 
 
End With
 
End Sub

Sauf que sur ma cle2, en cas de doublon au niveau des pourcentages ma liste et complètement décalé, j'aimerais donc pouvoir faire quelque chose comme ça:

Code :

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

1
2
3
4
5
If Not dico.exists(cle) Then 
dico.Add cle, 1 
dico1.Add cle1, 1 
dico2.Add cle2, 1
End if

au lieu de ça:

Code :

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

1
2
3
      If (Not dico.exists(cle)) Then dico.Add cle, 1
      If (Not dico1.exists(cle1)) Then dico1.Add cle1, 1
      If (Not dico2.exists(cle2)) Then dico2.Add cle2,

[Invité]

Code :

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

 dico(cle)= 1

[Cedrixxx]

Je peux avoir le code complet svp?

[Invité]

Code :

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

1
2
3
4
5
dico(cle)= 1
dico1(cle1)= 1
dico2(cle2)=?

[Cedrixxx]

Je suis vraiment désolé mais je ne comprend pas ce bout de code. Si c'est pour me demander ce que je souhaite avoir en cles2 c'est simplement un pourcentage de la machine qui sera dans les cles : cles et cles1 qui correspondent respectivement à la désignation de la machine et à son "matricule".

[Invité]

Bonjour,

Code ça :

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

dico.Add cle, 1

Code c'est la même chose que ça :

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

dico(cle)= 1

si la clé de dico existe ça ne change rien elle prend la valeur 1 et si elle n'existe pas elle est créé implicitement!

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
 For liFS = lidebFS To lifinFS    cptr = cptr + 1
 
    If .Range(coerrFS & liFS).Value > s And .Range(coerrFS & liFS).Value < 1 Then
'   If s <> .Range(coerrFS & liFS).Value And s <> 0 Then
 '  If s = .Range(coerrFS & liFS).Value Then
 
      cle = .Range(comacFS & liFS).Value
      cle1 = .Range(comacFS1 & liFS).Value
      cle2 = .Range(comacFS2 & liFS).Value
 
      'if cle == "" MsgBox('Clé vide ligne '. Afficher ligne et Colonne d'erreur .)
     If (IsEmpty(cle)) Then MsgBox "Vide 1 : Ligne" & liFS & "Colonne " & comacFS Else dico(cle) = 1
     If (IsEmpty(cle1)) Then MsgBox "Vide 2 : Ligne" & liFS & "Colonne " & comacFS1 Else dico1(cle1) = 1
     If (IsEmpty(cle2)) Then MsgBox "Vide 3 : Ligne" & liFS & "Colonne " & comacFS2 Else dico1(cle2) = 1
 
    End If
 
  Next liFS

on peut incrémenter un dico même si la clé n'existe pas!

Code :

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

dico(cle) = dico(cle) + 1