Aide pour programme qui compte un nombre de dates
Bonjour,
J'essaye de créer un programme qui compte le nombre de rendez-vous par mois parmi des données extraites et qui remplit par la suite un tableau en entrant le nombre de rendez-vous en fonction du mois et de l'année.
Le programme ne fonctionne pas malgré le fait qu'il ne m'affiche aucune erreur.
Les données de 2021 et 2022 sont fictives et entrées à la main j'aimerais qu'en faisant une extraction de manière automatique la ligne de 2023 se remplissent.
Auriez-vous une idée ?
Sub ComptabiliserDates()
Dim wsSource As Worksheet 'feuille contenant les dates extraites'
Dim wsDestination As Worksheet 'feuille de destination des résultats'
Dim rngSource As Range 'plage contenant les dates sources'
Dim cell As Range 'cellule de la plage source'
Dim dateValue As Date 'valeur de la cellule convertie en date'
Dim yearValue As String 'année'
Dim monthColumn As Range 'colonne mois'
Dim countTable As Range 'tableau pour compter les dates'
Set wsSource = ThisWorkbook.Worksheets("Feuil4")
Set wsDestination = ThisWorkbook.Worksheets("Synthèse")
Set rngSource = wsSource.Range("B2:B" & wsSource.Cells(wsSource.Rows.Count, 2).End(xlUp).Row)
Set countTable = wsDestination.Range("H3:U9").CurrentRegion
'Parcourir chaque cellule de la plage source'
For Each cell In rngSource
'vérifier si la cellule contient une date'
If IsDate(cell.Value2) Then
dateValue = CDate(cell.Value2)
'obtenir l'année de la cellule'
yearValue = CStr(cell.Value2)
'rechercher la colonne correspondant au mois de la date' 'Rows(6) car la ligne contenant le nom des mois est la 6ème'
Set monthColumn = countTable.Rows(6).Find(Format(dateValue, "mmm"), LookIn:=xlValues, LookAt:=xlWhole)
'vérifier si la colonne correspond au mois qui existe'
If Not monthColumn Is Nothing Then
'incrémenter le nombre de dates pour l'année et le mois correspondant '
'recherche l'année yearValue dans la première colonne du tableau de destination' '+1 correspond au décalage d'une colonne par rapport à la première du tableau de destination'
wsDestination.Cells(Application.Match(yearValue, countTable.Columns(1), 0), monthColumn.Column).Value = wsDestination.Cells(Application.Match(yearValue, countTable.Columns(1), 0), monthColumn.Column).Value + 1
End If
End If
Next cell
countTable.Columns.AutoFit
MsgBox "Comptage des dates terminé."
End Sub
Merci beaucoup, bonne journée.
Hello,
Pourquoi pas faire un tcd directement ?
@+
Bonjour, je dois coder ce programme dans le cadre de mes études et il nous a été demandé de ne pas utiliser les tableaux croisés dynamiques.
De plus, j'effectue une extraction de données qui ensuite constitue les données du tableau or je ne sais pas si avec un tcd à chaque extraction celui ci s'automatiserait sans saisir à nouveau la plage de données. Je ne maîtrise pas trop les tcd. Merci de bien vouloir m'aider à corriger mon code si il est possible de réaliser ce que je souhaite par VBA.
Hello,
Envoie ton fichier stp
@+