Bonjour,
N'étant pas un As de la macro et pas du tout informaticien, j'aurais besoin d'aide svp...
J'ai un classeur contenant une liste de références. Selon la référence, il y a dans une colonne une "X" ou un N/A On l'appellera Liste 17025
Dans un autre classeur d'archive, j'ai tout les lots contrôlés au cours de l'année et donc toutes les Réf. on l'appelle Archive
Je voudrais que ma macro qui parcours toutes les Réf du classeur Liste 17025 et que pour chaque Réf, il aille dans les archives, il filtre la première colonne Réf sur le numéro de Réf et compte toutes les ligne et donc toutes les réf.
Une fois ceci fait, je veux que la macro fasse la même chose pour la Référence suivant du classeur Liste 17025
en gros :
classeur 17025 colonne 1 ligne 1 = numéro réf ==> Classeur archive colonne 1, filtre sur numéro Réf ==> compte le nombre de valeur de la ligne 3 à la dernière ligne sur la réf filtrée ==> ajoute cette valeur au classeur liste 17025 en colonne 17 sur la ligne de la réf testée
procéder de même pour la ligne 2 etc.. jusqu'à la dernière ligne
J'ai fait un test mais ca ne marche pas...
Voici mon code que j'ai essayé de mettre en forme:
Sachant que le tableau à changer, il y avait un code qui est incompréhensible pour moi et qui ne marche pas non plus (c'est pour ca que je cherche à le refaire):
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 Sub Test() Dim LigFin As Long 'valeur numérique Dim NumRef As Long 'valeur numérique Dim LigDeb As Long 'valeur numérique Dim lig As Long 'valeur numérique Dim Nblot As Long 'valeur numérique Dim i As Integer If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False End If 'Recherche de la der lig utilisée en col 1 (N° de ref) LigFin = Sheets("liste 17025").Cells(Rows.Count, 1).End(xlUp).Row LigDeb = 3 If LigFin < LigDeb Then MsgBox "Problème lors de l'exécution de la macro, appellez MCH" End End If For i = LigDeb To LigFin 'parcourir l'ensemble des réf une par une Application.ScreenUpdating = False 'ouverture des archives Workbooks.Open Filename:="" & ThisWorkbook.Worksheets("Test").Cells(17, 2) & "", WriteResPassword:="history" NumRef = Workbooks("Liste 17025").Sheets("liste 17025").Cells(i, 1).Value If Workbooks("Liste 17025").Sheets("liste 17025").Cells(i, 16).Value = "X" Then 'filtrer sur la réf en cours de test (NumRef) Workbooks("" & ThisWorkbook.Worksheets("Test").Cells(17, 2) & "").Worksheets("Liste T&F").Range("A4:CE2999").Sort Key1:=NumRef, Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom 'compte le nombre de ligne présente avec le filtre dans les archives page T&F Nblot = Workbooks("" & ThisWorkbook.Worksheets("Test").Cells(17, 2) & "").Worksheets("Liste T&F").Cells(Rows.Count, 1).End(xlUp).Row 'ajouter ce nombre de valeur à a la colonne nombre de réfs controlé dans l'année Workbooks("Liste 17025").Sheets("liste 17025").Cells(i, 17).Value = Nblot Nblot = 0 End If 'passer à la Réf suivante. Next i End Sub
Voici l'ancien code:
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
95
96
97
98
99
100
101
102
103
104 Option Explicit Public lot_accr_cpt, lot_meth_cpt As Integer Public cpt_meth Private Sub init() lot_accr_cpt = 0 lot_meth_cpt = 0 cpt_meth = Array(0, 0, 0, 0, 0, 0, 0, 0) Worksheets("Indicateur").Range("C5:C6").ClearContents End Sub Private Sub methode_account(ByVal i, ByVal col, ByVal meth, ByVal CurWs As Worksheet, ByVal ArchWs As Worksheet) Dim j As Integer j = 4 If CurWs.Cells(i, col).Value = "X" Then While ArchWs.Cells(j, 1).Value <> "" If ArchWs.Cells(j, 1).Value = CurWs.Cells(i, 1).Value Then cpt_meth(meth) = cpt_meth(meth) + 1 lot_meth_cpt = lot_meth_cpt + 1 End If j = j + 1 Wend End If End Sub Private Sub data_fill(ByVal worksheet_name) Dim i, j As Integer Dim CurWs, ArchWs As Worksheet i = 3 j = 4 Set CurWs = Worksheets("liste 17025") Set ArchWs = Workbooks("Archives_2013.xls").Worksheets(worksheet_name) While CurWs.Cells(i, 1).Value <> "" 'là ci-dessous, vu la nouvelle version ce n'est plus un code couleur mais une "X" dans la colonne 16 du classeur Liste 17025 If CurWs.Cells(i, 1).Interior.ColorIndex = 45 Or CurWs.Cells(i, 1).Interior.ColorIndex = 38 Then While ArchWs.Cells(j, 1).Value <> "" If ArchWs.Cells(j, 1).Value = CurWs.Cells(i, 1).Value Then lot_accr_cpt = lot_accr_cpt + 1 End If j = j + 1 Wend j = 4 End If Call methode_account(i, 5, 0, CurWs, ArchWs) Call methode_account(i, 6, 1, CurWs, ArchWs) Call methode_account(i, 8, 2, CurWs, ArchWs) Call methode_account(i, 9, 3, CurWs, ArchWs) Call methode_account(i, 10, 4, CurWs, ArchWs) Call methode_account(i, 11, 5, CurWs, ArchWs) Call methode_account(i, 12, 6, CurWs, ArchWs) Call methode_account(i, 14, 7, CurWs, ArchWs) ' If CurWs.Cells(i, 3).Value = "X" Or CurWs.Cells(i, 4).Value = "X" Or CurWs.Cells(i, 5).Value = "X" Or CurWs.Cells(i, 6).Value = "X" Or _ ' CurWs.Cells(i, 7).Value = "X" Or CurWs.Cells(i, 8).Value = "X" Or CurWs.Cells(i, 9).Value = "X" Or CurWs.Cells(i, 10).Value = "X" Or _ ' CurWs.Cells(i, 11).Value = "X" Or CurWs.Cells(i, 12).Value = "X" Or CurWs.Cells(i, 13).Value = "X" Or CurWs.Cells(i, 14).Value = "X" Then ' While ArchWs.Cells(j, 1).Value <> "" ' If ArchWs.Cells(j, 1).Value = CurWs.Cells(i, 1).Value Then ' lot_meth_cpt = lot_meth_cpt + 1 ' End If ' j = j + 1 ' Wend ' j = 4 ' End If i = i + 1 Wend End Sub Private Sub indicator() Worksheets("Indicateur").Cells(5, 3).Value = lot_accr_cpt Worksheets("Indicateur").Cells(6, 3).Value = lot_meth_cpt Worksheets("Indicateur").Cells(8, 3).Value = cpt_meth(0) Worksheets("Indicateur").Cells(9, 3).Value = cpt_meth(1) Worksheets("Indicateur").Cells(10, 3).Value = cpt_meth(2) Worksheets("Indicateur").Cells(11, 3).Value = cpt_meth(3) Worksheets("Indicateur").Cells(14, 3).Value = cpt_meth(4) Worksheets("Indicateur").Cells(13, 3).Value = cpt_meth(5) Worksheets("Indicateur").Cells(12, 3).Value = cpt_meth(6) Worksheets("Indicateur").Cells(15, 3).Value = cpt_meth(7) End Sub Sub main() Call init Call data_fill("Liste PETRI") Call data_fill("Liste T&F") Call indicator Sheets("Indicateur").Select End Sub
Partager