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 |
Partager