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
| Sub TabPareto2()
Dim Tab_init, Tab_final(), Nb_Machine&, i&, x&
With ThisWorkbook.Sheets("Listing-machine")
Nb_Machine = Application.WorksheetFunction.CountIf(.Range("AI8:AI" & .Cells(Rows.Count, "AI").End(xlUp).Row), "<1") 'A2 car on considère une en-tête
'Paramétré la Range/colonne des pourcentages - si le % est en Col E remplacé A par E par exemple
Tab_init = .Range("A8:AI" & .Cells(Rows.Count, "AI").End(xlUp).Row).Value ' Paramétré la plage selon données
End With
ReDim Tab_final(1 To Nb_Machine + 1, 1 To 3)
Tab_final(1, 1) = "Désignation": Tab_final(1, 2) = "N°Machine": Tab_final(1, 3) = "DI"
For i = 2 To UBound(Tab_init) 'on considère qu'il y aune en-tête donc on commence à 2
If Tab_init(i, 35) < 1 And Tab_init(i, 2) > "" Then 'Avec Tab_init(i, 2) > "" de rajouter on supprime toutes les lignes n'ayant pas de N° de Machine
x = x + 1
Tab_final(x + 1, 1) = Tab_init(i, 3): Tab_final(x + 1, 2) = Tab_init(i, 2): Tab_final(x + 1, 3) = Tab_init(i, 35)
' La ColonneDésignation, ColonneN°Machine et ColonneDI doivent être remplacées par le chiffre de la colonne dans le tableau
'Exemple : si le tableau commence en colonne A jusqu'à E : Désig se trouve en col A donc on remplacera par 1 - N°Machine se trouve en Col C donc on emplacera par 3 etc …
End If
Next
With ThisWorkbook
Application.ScreenUpdating = False
With .Sheets("MonTabPareto") ' à remplacer
.Range("A1").CurrentRegion.Clear
'Attention Voir dans l'aide VBA "Clear" => .Range("A1").CurrentRegion.ClearContents serait surement plus approprié selon ce que l'on veut faire. Donc à voir
.Range("A1").Resize(UBound(Tab_final, 1), UBound(Tab_final, 2)).Value = Tab_final
.Columns.AutoFit ' ici on réajuste toutes les colonnes selon le contenu des cellules
'ou si l'on veut juste réajuster les colonnes A, B et C => Columns("A:C").autofit
End With
Application.ScreenUpdating = True
End With
End Sub |
