Discussion :

[vba_lieb]

Bonjour le forum,

J'ai dans une colonne A un ensemble de référence
En colonne B, j'ai la date de réception

Je désire compte dans une cellule le nombre de référence pour cette semaine. Dans une autre cellule compte le nombre pour ce mois et enfin dans une troisième cellule, compter pour l'année en cours.

J'ai beau chercher, je n'y arrive pas...

Merci pour votre coup de pousse et encore bravo pour toutes les infos que l'on peut glaner ici.

Lieb

[Nain porte koi]

Hello,

en l'absence de vos propre données voici un exemple

[vba_lieb]

Hello,

en l'absence de vos propre données voici un exemple

Bonjour,

Merci pour votre aide,

Par contre, effectivement, j'ai oublié d'importer mon fichier d'exemple. Le votre est parfait !
Un deuxième oubli, c'est que je voulais tout cela en VBA_Script. Je garde précieusement dans tous les cas les formules fournit qui pourrait me servir pour un autre projet Excel.

Merci à vous

[patmeziere]

Bonjour
en me basant sur l'exemplaire de Nain porte quoi
comme ça vite fait

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
Option Explicit
Function NBRefByWeeK(ref As String)
    Dim X&, C&, Cel As Range
    X = WorksheetFunction.IsoWeekNum(Date)
    With Range("tableau1")
        For Each Cel In .Columns(1).Cells
            If Cel = ref Then
                If WorksheetFunction.IsoWeekNum(CDate(Cel.Offset(, 1))) = X Then C = C + 1
            End If
        Next
    End With
    NBRefByWeeK = C
End Function
'---------------------------------------------------------------------------------------------------
Function NBRefByMonth(ref As String)
    Dim X&, C&, Cel As Range
    X = Month(Date)
    With Range("tableau1")
        For Each Cel In .Columns(1).Cells
            If Cel = ref Then
                If Month(CDate(Cel.Offset(, 1))) = X Then C = C + 1
            End If
        Next
    End With
    NBRefByMonth = C
End Function
'---------------------------------------------------------------------------------------------------
Function NBRefByYear(ref As String)
    Dim X&, C&, Cel As Range
    X = Year(Date)
    With Range("tableau1")
        For Each Cel In .Columns(1).Cells
            If Cel = ref Then
                If Year(CDate(Cel.Offset(, 1))) = X Then C = C + 1
            End If
        Next
    End With
    NBRefByYear = C
End Function
'---------------------------------------------------------------------------------------------------
 
'pour tester
Sub testsemaine()
    MsgBox NBRefByWeeK("slmqdf")
End Sub
 
Sub testmois()
    MsgBox NBRefByMonth("slmqdf")
End Sub
 
Sub testannée()
    MsgBox NBRefByYear("slmqdf")
End Sub

patrick

[vba_lieb]

Bonjour et merci pour ton aide,

Je vais regarder pour essayer de comprendre dans tous les cas.

Toutefois, j'ai un début de code qui me compte toutes les cellules. Je me demandais si en changeant la le

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Range("B" & I) < Date Then

je pouvais effectuer le calcul.


Voici déja le code que j'ai :

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
'Dans Excel, j'ai renommé ma feuille en FEUILLE_TEST
'Donc :
'On déclare la feuille source dans le fichier ARCHIVES LIEBHERR1
Set WcArchive = ThisWorkbook.Worksheets.Worksheets("FEUILLE_TEST")
 
 
'En B j'ai mes dates de réception
 
' --- CALCUL DES OF RECUS SEMAINE / MOIS / ANNEE ---
'Colonne date de réception : B
Dim I As Long, J As Long, nbLignes As Long, nbCol As Long
    Dim Cnt As Long
    nbLignes = WcArchive.Cells(Rows.Count, "B").End(xlUp).Row
    'nbCol = WcArchive.Range("B").Column
    For I = 4 To nbLignes
        If IsDate(Range("B" & I)) Then
                If Range("B" & I) < Date Then
                    Cnt = Cnt + 1
                End If
            End If
        Next
 
'On ecrit les résultats dans le DASHBOARD
'OF reçu depuis le début de l'annnée
ThisWorkbook.Worksheets("DASHBORD").Range("E10") = Cnt
 
 
End Sub

A dispo pour et merci encore

Lieb

[vba_lieb]

Alors, je continue mes investigations :

J'ai réussi a isoler dans des variables, la date du jour, la semaine en cours, le mois en cours et l'année en cours.

Voici le travail que je partage qui pourrait servir :

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
Sub BILAN_DATE()
 
    Dim iDay As String
    Dim iSemaine As String
    Dim iMois As String
    Dim iAnnee As String
    Dim noSemaine As String
    'On place la date dans la variable iDay
	iDay = Date
 
    'On place le numero de semaine dans la variable iSemaine
	iSemaine = DatePart("ww", iDay, vbMonday, vbFirstFourDays)
 
	'On place le numero de mois dans la variable iMois
    iMois = Month(Date)
 
	'On place l'année en cours dans la variable iAnnee
    iAnnee = Year(Date)
 
	'Et enfin, pour valider, je vérifie via MsgBox qui mes variables sont bonnes :
    MsgBox ("La date d'aujourd'hui est : " & iDay)
    MsgBox ("La semaine en cours est : " & iSemaine)
    MsgBox ("Le mois en cours est : " & iMois)
    MsgBox ("L'année en cours est : " & iAnnee)
 
End Sub

Bon maintenant faut trouver pour boucler le tout afin de m'afficher mes valeurs...

[Nain porte koi]

Re,

une question : pourquoi vouloir du VBA alors que les fonctions d'Excel existent et que c'est pour mettre le résultat dans une cellule d'une autre feuille ?
En plus dans le VBA on est obligé d'utiliser des fonctions d'excel (WorksheetFunction.IsoWeekNum).

une autre : dans votre exemple vous ne comptez que les cellules dont la date est inférieure à la date actuelle alors que vous demandiez par semaine/mois/années, pourquoi ?
Et comme c'est avec un Sub au lieu d'une Function il faut relancer la macro à chaque fois

Chez moi la roue existe depuis pas mal de temps, j'évite de la réinventer

[vba_lieb]

Re,

une question : pourquoi vouloir du VBA alors que les fonctions d'Excel existent et que c'est pour mettre le résultat dans une cellule d'une autre feuille ?
En plus dans le VBA on est obligé d'utiliser des fonctions d'excel (WorksheetFunction.IsoWeekNum).

une autre : dans votre exemple vous ne comptez que les cellules dont la date est inférieure à la date actuelle alors que vous demandiez par semaine/mois/années, pourquoi ?
Et comme c'est avec un Sub au lieu d'une Function il faut relancer la macro à chaque fois

Chez moi la roue existe depuis pas mal de temps, j'évite de la réinventer

Bonjour,

Alors, j'utilise VBA car c'est pour mettre à jour lorsque un fichier source est ouvert, et dont les infos des dates sont dedans.

Bon en tout cas l'aide m'a aider à finaliser

Je vous mets ici le script sachant que j'écris dans mon fichier excel dans la feuille DASHBORD (oui je sais y a une faute) les résultats. Ca fonctionne parfaitement :
A customiser pour ces besoins

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
Sub BILAN_DATE()
 
' --- CALCUL DES OF RECUS CETTE SEMAINE ---
'Colonne date de réception : B
    Dim I As Long
    Dim Cnt As Long
    Dim iDay As String
    Dim iSemaine As String
    Dim iMois As String
    Dim iAnnee As String
    Dim noSemaine As String
    Dim nbLignes As Long
 
    'Variable pour recherche NB de cellule avec semaine en cours
    Dim Date_Cel As String
    Dim Semaine_Cel As String
 
    'Variable pour recherche NB de cellule avec le mois en cours
    Dim Month_Find As String
 
 
    'On parametre nos variables
    nbLignes = WcArchive.Cells(Rows.Count, "B").End(xlUp).Row
    iDay = Date
    iSemaine = DatePart("ww", iDay, vbMonday, vbFirstFourDays)
    iMois = Month(Date)
    iAnnee = Year(Date)
    'MsgBox ("La date d'aujourd'hui est : " & iDay)
    'MsgBox ("La semaine en cours est : " & iSemaine)
    'MsgBox ("Le mois en cours est : " & iMois)
    'MsgBox ("L'année en cours est : " & iAnnee)
 
'On recherche le nombre de cellule ANNEE EN COURS
    nbLignes = WcArchive.Cells(Rows.Count, "B").End(xlUp).Row
 
    'Ici on défini à partir de quelle ligne on doit chercher (Ici c'est la ligne 3)
    For I = 3 To nbLignes
        'If IsDate(Range("B" & I)) Then
                If Format(WcArchive.Range("B" & I).Value, "YYYY") = iAnnee Then
                Cnt = Cnt + 1
                End If
            'End If
        Next
'On ecrit les résultats dans le DASHBOARD
    MsgBox ("On écrit le résultat ANNEE dans le Dashboard : " & Cnt)
    ThisWorkbook.Worksheets("DASHBORD").Range("E10") = Cnt
'On remet à zéro le compteur
Cnt = 0
 
'On recherche le nombre de cellule MOIS EN COURS
    'Je commence ma recherche à la ligne 3
    For I = 3 To nbLignes
                'Je mets dans une variable mois et année de la cellule colonne B
                Month_Find = Format(WcArchive.Range("B" & I).Value, "MM/YYYY")
 
                'Puis si il y a un zero, alors je supprime celui-ci (exemple pour 01 qui est Janvier)
                'Car iDay n'a pas le zero
                If Left(Month_Find, 1) = "0" Then Month_Find = Right(Month_Find, Len(Month_Find) - 1)
 
                'Et maintenant vérification si mois et l'année correspond au mois et l'année de ce jour
                'Et si oui, je rajoute 1 à ma variable Cnt
                If Month_Find = iMois & "/" & iAnnee Then
                Cnt = Cnt + 1
                End If
    Next
'On ecrit les résultats dans le DASHBOARD
    MsgBox ("On écrit le résultat Mois dans le Dashboard : " & Cnt)
    ThisWorkbook.Worksheets("DASHBORD").Range("E8") = Cnt
'On remet à zéro le compteur
Cnt = 0
 
 
'On recherche le nombre de cellule de cette semaine
    'Je commence ma recherche à la ligne 3
    For I = 3 To nbLignes
        Date_Cel = Format(WcArchive.Range("B" & I).Value, "DD/MM/YYYY")
        Semaine_Cel = DatePart("ww", Date_Cel, vbMonday, vbFirstFourDays)
        'MsgBox ("La semaine en cours est : " & iSemaine)
        'MsgBox ("La date de la cellule est : " & Date_Cel)
        'MsgBox ("La semaine de la cellule est : " & Semaine_Cel)
            If Semaine_Cel = iSemaine Then
            Cnt = Cnt + 1
            End If
    Next
'On ecrit les résultats dans le DASHBOARD
    'MsgBox ("On écrit le résultat SEMAINE dans le Dashboard : " & Cnt)
    ThisWorkbook.Worksheets("DASHBORD").Range("E6") = Cnt
'On remet à zéro le compteur
Cnt = 0
 
 
 
' --- FIN CALCUL DES OF RECUS SEMAINE / MOIS / ANNEE ---
 
End Sub

Je vous cache pas que pour le calcul par semaine, j'ai du faire craquer quelques neurones

Un grand merci dans tous les cas !

Voilou, je cloture car pour moi c'est ok

[Nain porte koi]

Alors, j'utilise VBA car c'est pour mettre à jour lorsque un fichier source est ouvert, et dont les infos des dates sont dedans.

Heum... si je ne me trompe pas... votre procédure n'indique pas où se trouve "WcArchive", si elle est dans le même classeur que la feuille "DASHBORD" les formules de calculs feront le calcul dès l'ouverture du fichier. Si "WcArchive" ne se trouve pas dans le même classeur, les formules de calculs feront le calculs dès l'ouverture du fichier ou pas selon si vous accepter qu'Excel aille chercher les données...
Je vais me répéter, mais pourquoi passer par le VBA quand Excel à des fonctions NATIVES qui font le job ?

Un détails en passant, votre procédure prend un numéro de semaine seul et un numéro de mois seul aussi... que ce passe t'il si vous avez 2 années dans les données de "WcArchive" ?

Un autre cette partir peut être simplifié :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
                Month_Find = Format(WcArchive.Range("B" & I).Value, "MM/YYYY")
 
                'Puis si il y a un zero, alors je supprime celui-ci (exemple pour 01 qui est Janvier)
                'Car iDay n'a pas le zero
                If Left(Month_Find, 1) = "0" Then Month_Find = Right(Month_Find, Len(Month_Find) - 1)

en

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

                Month_Find = Format(WcArchive.Range("B" & I).Value, "M/YYYY")

Si un mois a 2 chiffres ça ne vas pas supprimer l'un des 2

[vba_lieb]

Merci pour ton retour,

Alors déja, effectivement, j'ai pas mis le script complet.
WcArchive permet d'indiquer dans le script le chemin de mon fichier source.
Donc pour ce qui nous lie, il faut adapter la ligne suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

FILE_SOURCE = "METTRE_ICI_CHEMIN_COMPLET_AVEC_NOM_FICHIER_ET_EXTENSION"

Ne pas oublier aussi de modifier le nom de la feuille ou se trouve l'ensemble des données à analyser (actuellement DATABASE_SOURCE)
Modifier si dessous la ligne selon vos besoins.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set WcArchive = WbArchive.Worksheets("DATABASE_SOURCE")

Voici le script complet :

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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
'Attention les deux lignes suivantes doivent être impérativement placées en tout début de programme
Option Explicit  'Activation de la déclaration explicite des variables
Public WbArchive As Workbook
Public WcArchive As Worksheet
 
Sub BILAN_OF_SEMAINE()
 
'On cache les classeurs qui vont s'ouvrir pour éviter les sauts d'écran
'ATTENTION, NE PAS OUBLIER DE METTRE A TRUE EN FIN DE SCRIPT
Application.ScreenUpdating = False
 
 
'--------- DECLARATION EMPLACEMENT FICHIER : FICHIER SOURCE ---------
'On déclare le fichier source de donnée ARCHIVES
Dim FILE_SOURCE As String
FILE_SOURCE = "METTRE_ICI_CHEMIN_COMPLET_AVEC_NOM_FICHIER_ET_EXTENSION"
 
'On déclare la variable qui contiendra la référence du fichier FICHIER SOURCE
'On ouvre le fichier Archives
Set WbArchive = Workbooks.Open(FILE_SOURCE)
 
'On déclare la feuille source dans le fichier ARCHIVES LIEBHERR1
Set WcArchive = WbArchive.Worksheets("DATABASE_SOURCE")
 
' --- CALCUL DES OF RECUS CETTE SEMAINE ---
'Colonne date de réception : B
    Dim I As Long
    Dim Cnt As Long
    Dim iDay As String
    Dim iSemaine As String
    Dim iMois As String
    Dim iAnnee As String
    Dim noSemaine As String
    Dim nbLignes As Long
 
    'Variable pour recherche NB de cellule avec semaine en cours
    Dim Date_Cel As String
    Dim Semaine_Cel As String
 
    'Variable pour recherche NB de cellule avec le mois en cours
    Dim Month_Find As String
 
 
    'On parametre nos variables
    nbLignes = WcArchive.Cells(Rows.Count, "B").End(xlUp).Row
    iDay = Date
    iSemaine = DatePart("ww", iDay, vbMonday, vbFirstFourDays)
    iMois = Month(Date)
    iAnnee = Year(Date)
    'MsgBox ("La date d'aujourd'hui est : " & iDay)
    'MsgBox ("La semaine en cours est : " & iSemaine)
    'MsgBox ("Le mois en cours est : " & iMois)
    'MsgBox ("L'année en cours est : " & iAnnee)
    'MsgBox ("L'année en cours est : " & iMois & "/" & iAnnee)
 
'On recherche le nombre de cellule ANNEE EN COURS
    nbLignes = WcArchive.Cells(Rows.Count, "B").End(xlUp).Row
 
    'Ici on défini à partir de quelle ligne on doit chercher (Ici c'est la ligne 3)
    For I = 3 To nbLignes
        'If IsDate(Range("B" & I)) Then
                If Format(WcArchive.Range("B" & I).Value, "YYYY") = iAnnee Then
                Cnt = Cnt + 1
                End If
            'End If
        Next
'On ecrit les résultats dans le DASHBOARD
    'MsgBox ("On écrit le résultat ANNEE dans le Dashboard : " & Cnt)
    ThisWorkbook.Worksheets("DASHBORD").Range("E10") = Cnt
'On remet à zéro le compteur
Cnt = 0
 
'On recherche le nombre de cellule MOIS EN COURS
    'Je commence ma recherche à la ligne 3
    For I = 3 To nbLignes
                'Je mets dans une variable mois et année de la cellule colonne B
                Month_Find = Format(WcArchive.Range("B" & I).Value, "MM/YYYY")
                'MsgBox Month_Find
 
                'Puis si il y a un zero, alors je supprime celui-ci (exemple pour 01 qui est Janvier)
                'Car iDay n'a pas le zero
                If Left(Month_Find, 1) = "0" Then Month_Find = Right(Month_Find, Len(Month_Find) - 1)
 
                'Et maintenant vérification si mois et l'année correspond au mois et l'année de ce jour
                'Et si oui, je rajoute 1 à ma variable Cnt
                If Month_Find = iMois & "/" & iAnnee Then
                Cnt = Cnt + 1
                End If
    Next
'On ecrit les résultats dans le DASHBOARD
    'MsgBox ("On écrit le résultat Mois dans le Dashboard : " & Cnt)
    ThisWorkbook.Worksheets("DASHBORD").Range("E8") = Cnt
'On remet à zéro le compteur
Cnt = 0
 
 
'On recherche le nombre de cellule de cette semaine
    'Je commence ma recherche à la ligne 3
    For I = 3 To nbLignes
        Date_Cel = Format(WcArchive.Range("B" & I).Value, "DD/MM/YYYY")
        Semaine_Cel = DatePart("ww", Date_Cel, vbMonday, vbFirstFourDays)
        'MsgBox ("La semaine en cours est : " & iSemaine)
        'MsgBox ("La date de la cellule est : " & Date_Cel)
        'MsgBox ("La semaine de la cellule est : " & Semaine_Cel)
            If Semaine_Cel = iSemaine Then
            Cnt = Cnt + 1
            End If
    Next
'On ecrit les résultats dans le DASHBOARD
    'MsgBox ("On écrit le résultat SEMAINE dans le Dashboard : " & Cnt)
    ThisWorkbook.Worksheets("DASHBORD").Range("E6") = Cnt
'On remet à zéro le compteur
Cnt = 0
 
' --- FIN CALCUL DES OF RECUS SEMAINE / MOIS / ANNEE ---
 
'On ferme FICHIER SOURCE SANS enregistrement
WbArchive.Close SaveChanges:=False
 
'On dé-cache les classeurs nécéssaires ouvert
'ATTENTION, NE PAS OUBLIER DE METTRE A TRUE EN FIN DE SCRIPT
Application.ScreenUpdating = True
 
End Sub

En ce qui concerne le calcul pour la semaine, dans la variable iSemaine, je mets la semaine en cours

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

iSemaine = DatePart("ww", iDay, vbMonday, vbFirstFourDays)

Puis au final, je compare avec la date de la cellule

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Date_Cel = Format(WcArchive.Range("B" & I).Value, "DD/MM/YYYY")
        Semaine_Cel = DatePart("ww", Date_Cel, vbMonday, vbFirstFourDays)
            If Semaine_Cel = iSemaine Then
            Cnt = Cnt + 1
            End If

Voilà pour les retours. Sinon, effectivement, suis preneur de conseil sans souci car il y a 3 mois j'avais quasi aucune connaissance en VBA et mon expérience de ce jour, je le dois à votre site et surtout à ceux qui le font vivre.
Merci encore

Lieb