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,