Macro de comptage

Version imprimable

Macro de comptage

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:

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:

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

28/02/2014, 14h52
bboy-eazy

1 pièce(s) jointe(s)

voici le classeur en PJ:
28/02/2014, 15h30
YanBos

Hello,

Si la question c'est le nombre de Refs particulières présentes dans les archives, au lieu de filtrer sur le nom de la Ref puis de compter le nombre de valeurs une fois le filtre appliqué, est ce qu'on ne pourrait pas se servir juste d'une formule Countif ?

Un truc dans le genre: =Countif(Range de la feuille Archives, Valeurs Ref dans liste 17025) ce qui nous donnerait pour chaque Ref de la liste 17025, son nombre d'occurences dans la liste d'Archives?
28/02/2014, 15h43
bboy-eazy

c'est exactement ca ! :D

je passais par le filtre mais c'est la solution archaique car je connais pas toutes les fonction VBA et les possibilités mais je savais pas qu'il y avait une fonction countif.

Comment s'écrit elle ? (enfin comment faut il porceder?)

Merci d'avance
28/02/2014, 15h55
YanBos

1 pièce(s) jointe(s)

Vu que je suis pas un pro de vba je ferai ça à la mano si c'est pas quelque chose à faire 5 fois par jour (fichier attaché pour l'exemple).

Pour du VBA, il va falloir attendre les experts :lol:

Bonjour

Après plusieurs relecture, j'arrive au resultat suivant.
A coller dans le classeur liste 17025, clic droit sur l'onglet concerné, et visualiser le code.
les chiffres se mettrons a jour a chaque activation de la feuille.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Private Sub Worksheet_Activate() Dim wkd As Workbook Dim Wks As Workbook Dim cell As Range 'definit le classeur destination Set wkd = ThisWorkbook 'definit le classeur source, et l'ouvre en lecture seule Set Wks = Application.Workbooks.Open("c:\archives.xls", , True) 'pour chaque ligne, on compte le nombre de valeur se trouvant dans archives avec nb.si For Each cell In wkd.Sheets("list").Range("b3:b" & [b65000].End(xlUp).Row) cell.Offset(0, 1).Formula = "=COUNTIF([" & Wks.Name & "]Archives!C2:C" & Wks.Sheets("archives").[c65000].End(xlUp).Row & " ," & cell.Address & ")" Next cell 'ferme le classeur source Wks.Close False End Sub
si j'ai bien compris, pour chaque reference se trouvant dans le classeur list17025, feuille 17025, il faut compter le nombre de valeurs
equivalente se trouvant dans le classeur archive sur la feuille archives.
si cela ne fonctionne pas, priere de bien vouloir communiquer précisément le nom du classeur source avec chemin complet.
Le nom de la feuille, la plage de cellule ou se trouve les refs a compter
le nom de la feuille de destination avec ou setrouve les refs et ou doit se trouver le resultat.

03/03/2014, 10h12
bboy-eazy

2 pièce(s) jointe(s)

Merci a tous.

Keygen08 j'ai essayé votre macro il le déboguage dis que l'indice n'appartient pas a la selection. Mais comme je ne comprends pas tout à fait le code encore.. Je ne sais pas quelle plage mettre où. En tout cas c'est exactement ca:

alors je vous donne toutes les données:

chemin des archives:
\\Frmant02\Ctlbact\mathieu\SUIVI LOTS\sv\Archives.xls

Dans le classeur Liste 17025, les références se trouvent en colonne A de la feuille "liste 17025"
Dans le classeur des archives, les références à compter sont en colonne A également de la feuille Liste PETRI

Le nombre d'occurence obtenue est à ajouter dans le classeur Liste 17025 de la feuille Test dans la cellule C5

Merci beaucoup pour votre aide

Voici en PJ les tableaux si cela peut vous aider.

et les archives..

1 pièce(s) jointe(s)

Hello,

voilà un exemple "à la russe" sans maccros:

1°: Identifier la liste des Refs avec une croix (filter sur la colonne P)
2°: Compter le nombre d'occurences de ces Refs dans la liste Petri
3°: Compter le nombre d'occurences de ces Refs dans la liste T&F
4°: Faire la somme du tout

Voir le fichier joint.

Et une maccro qui fonctionne chez moi (inspirée du précédent code!):
Code:

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 Sub Newtry() Dim wkd As Workbook Dim Wks As Workbook Dim IntSum As Integer Dim cell As Range 'definit le classeur destination Set wkd = ThisWorkbook 'definit le classeur source, doit être déjà ouvert Set Wks = Workbooks("Archives.xls") 'On regarde pour chaque ligne si elle est cochée dans la colonne P For Each cell In wkd.Sheets("list").Range("P3:P" & [P3].End(xlDown).Row) If cell.Value = "X" Then 'MsgBox cell.Offset(0, -15).Value 'MsgBox Application.CountIf(Wks.Sheets("Liste PETRI").Range("A4:A" & Range("A4").End(xlDown).Row), cell.Offset(0, -15)) IntSum = IntSum + Application.CountIf(Wks.Sheets("Liste PETRI").Range("A4:A" & Range("A4").End(xlDown).Row), cell.Offset(0, -15)) 'On incrémente la somme End If Next cell 'on passe à la ligne suivante 'MsgBox "Total " & IntSum End Sub
Il faut juste rajouter le countif sur la 2ème liste T&F, ici le compte n'est que sur la liste Petri. :)

03/03/2014, 13h09
bboy-eazy

Bonjour,

Merci beaucoup Yanbos

C'est exactement ca.

Bien joué!

+1 :)

Bonne journée à tous et à bientôt