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:

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
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):

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