Compter nombre des RVD selon plusieurs critères -VBA
Salut tout le monde.
Je me tourne vers vous aujourd’hui parce que je ne comprends pas comment résoudre mon problème.
J’ai un tableau des RDV qu’est alimenté régulièrement via un Userform et qui marche bien.
Je cherche à faire des statistiques en fin d’année via un code VBA ;
Le but est compter le nombre des RDV selon les critères suivant :
- Année.
- Centre
- Nature du RDV (Biologique ou Radiologique)
- Et nature de la prise en charge (PRÊT ou DON)
Voir les résultats voulu à la feuille « STAT ».
NB : avec les formules c possible mais pour chaque année les centres peuvent changer.
Je vous mets mon fichier en pièce jointe a signalé que j’ai laissé que l’année 2018.
Merci à vous.
Bonjour,
Une proposition TCD (tableau croisé dynamique).
A te relire.
Cdlt.
Merci à ta réponse mais c c possible en VBA parce que j'ai déjà un userforme pour le saisi des RDV
bonjour
comme Jean-Eric
et j'ajoute que tu devrais supprimer toute macro (formulaire, stat...)
la saisie dans un chouette Tableau comme tu l'as fait se réalise directement dedans
fais tes stats par un TCD.
bien plus souple d'emploi que ton onglet state
note : n'oublie pas de créer une colonne "Terminé" pour différencier les RDV effectivement terminés de ceux non terminés. Le filtre te permet de ne voir au quotidien que les non terminés. Se fier à la date ne suffit pas, car il y a des annulations/reports non encore planifiés.
bon travail
amitiés
Re,
L'Userform fonctionne parfaitement, car il ne comporte pas de procédures VBA !...
J’ai un tableau des RDV qu’est alimenté régulièrement via un Userform et qui marche bien.
Cdlt.
merci bien.
mais SVP pouvez vous m'aider sans TCD.
Re,
Envoie ton fichier avec un Userform fonctionnel, et je reverrai le fichier, avec un TCD (en VBA).
Cdlt.
Bonjour, Salut Jean-Eric, jmd !
Solution macro utilisant le Userform :
Dim Brv, d As Object
Private Sub CommandButton1_Click()
Dim ETt, Tmp, k, i&, a%, j%
If ComboBox1.ListIndex > -1 Then a = CInt(ComboBox1.Value) Else Exit Sub
For i = 2 To UBound(Brv)
If Brv(i, 9) = a Then
k = Brv(i, 7)
j = (1 + (Brv(i, 5) = "BIOLOGIQUE")) * 2
j = j + 2 + (Brv(i, 4) = "PRÊT")
If Not d.exists(k) Then d(k) = Array(k, 0, 0, 0, 0, 0)
Tmp = d(k): Tmp(j) = Tmp(j) + 1: Tmp(5) = Tmp(5) + 1: d(k) = Tmp
End If
Next i
Tmp = d.items
With Worksheets("state").Range("A3")
.CurrentRegion.Clear
With .Resize(2, 6)
ETt = .Value
ETt(1, 1) = a: ETt(1, 2) = "BIOLOGIQUE": ETt(1, 4) = "RADIOLOGIQUE"
ETt(2, 2) = "PRÊT": ETt(2, 3) = "DON": ETt(2, 4) = ETt(2, 2)
ETt(2, 5) = ETt(2, 3): ETt(2, 6) = "Total"
.Value = ETt
.HorizontalAlignment = xlCenter
For i = 2 To 4 Step 2
.Cells(1, i).Resize(, 2).Merge
Next i
.Borders.Weight = xlThin
End With
With .Offset(2).Resize(d.Count, 6)
.Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(Tmp))
.Offset(, 1).Resize(, 5).HorizontalAlignment = xlCenter
.Borders.Weight = xlThin
.Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlNo
End With
With .Offset(d.Count + 2).Resize(, 6)
.Cells(1, 1) = "Total"
.Offset(, 1).Resize(, 5).HorizontalAlignment = xlCenter
.Borders.Weight = xlThin
For i = 2 To 6
.Cells(1, i) = WorksheetFunction.Sum(.Offset(-d.Count, i - 1).Resize(d.Count, 1))
Next i
End With
.Worksheet.Activate
End With
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim i&, aa
Brv = Worksheets("RDV").Range("A1").CurrentRegion
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(Brv)
d(Brv(i, 9)) = ""
Next i
aa = d.keys
Select Case d.Count
Case 0: Unload Me: Exit Sub
Case 1: ComboBox1.AddItem aa(0)
Case Else: ComboBox1.List = aa
End Select
d.RemoveAll
End SubCordialement.
edit : peut-être pas totalement optimal, car je n'ai vu ta ligne de totaux en bas de tableau qu'à la fin, et l'ai construite avec un rajout. Elle aurait sans doute pu être intégrée en amont.
Bonjour MFerrand.
Compliments pour le Vba
J'avais pensé à une option de Tcd suivie d'un copié collé spécial et la suppression du tcd ensuite... pour faire discret lol
merci MFerrand ca marche bien;
vu tu ajouter des commentaires pour bien comprendre votre code.
Je ne mets généralement pas de commentaires (sauf parfois des balises repères très réduites) car ça me gêne pour lire le code, il faut le chercher au milieu de commentaires
On va faire une exception...
Pour ordre : le caractère deux-points (:) inséré dans une ligne (sauf lorsqu'il fait partie d'un texte mis entre guillemets) est un séparateur de lignes de code, qui permet d'insérer plusieurs lignes de code sur la même ligne physique ;
le caractère underscore ( _) précédé d'une espace en fin de ligne physique indique que ce qui suit à la ligne suivante fait partie de la même ligne de code, c'est un caractère de continuité de ligne.
L'initialisation commentée :
Private Sub UserForm_Initialize()
Dim i&, aa
'Récupération des données sous forme tableau VBA, variable module car sera
' réutilisée par la procédure bouton
Brv = Worksheets("RDV").Range("A1").CurrentRegion
'Création dictionnaire, variable niveau module également, utilisé aussi par
' procédure bouton
Set d = CreateObject("Scripting.Dictionary")
'Boucle sur les lignes du tableau, on récupère l'année comme clé d'élément dico,
' il n'y aura qu'un élément dico par année figurant dans le fichier, pas de
' valeur, on ne s'en sert que pour obtenir un seul élément par année
For i = 2 To UBound(Brv)
d(Brv(i, 9)) = ""
Next i
'On affecte les clés de dico à un tableau - NB: j'opère une modification pour le cas
' de lancement sur un tableau RDV ne contenant aucune donnée ! On n'aurait recueilli
' aucune année, ce qui engendrerait une erreur...
If d.Count > 0 Then aa = d.keys Else Unload Me: Exit Sub 'ligne modifiée
'NB:la modification ci-dessus élimine le cas 0 ci-dessous
' on distingue le cas 1 car on ne peut affecter la liste des années par List dans ce
' cas (obligation d'utiliser alors AddItem)
' Donc on affecte la liste des années à la Combo
Select Case d.Count
Case 1: ComboBox1.AddItem aa(0)
Case Else: ComboBox1.List = aa
End Select
'On supprime tous les éléments dico (ils ne reserviront pas pour la phase suivante)
' En fin de proc.d'initialisation, le Userform s'affiche
d.RemoveAll
End SubEt la procédure principale :
Private Sub CommandButton1_Click()
Dim ETt, Tmp, k, i&, a%, j%
'Si sélection d'une année dans la Combo, on la récupère dans la variable a,
' sinon... rien ! A l'utilisateur de réagir
If ComboBox1.ListIndex > -1 Then a = CInt(ComboBox1.Value) Else Exit Sub
'Boucle sur les lignes de tableau de données qui a été conservé dans la
' variable module Brv
For i = 2 To UBound(Brv)
'On ne s'intéresse qu'aux lignes correspondant à l'année choisie
If Brv(i, 9) = a Then
'On recueille le Centre dans la variable k
k = Brv(i, 7)
'On définit dans la variable j (Integer) un numéro de colonne de tableau à
' une dimension à partir des mentions 'BIOLOGIQUE' en E et 'PRÊT' en D (on
' considère que si Faux à ce test on a 'RADIOLOGIQUE' et 'DON')
'Le test est fait au moyen d'expressions booléennes intégrées dans le calcul,
' je te laisse le vérifier sachant que True=-1 et False=0... le résultat
' correspond à la colonne du tableau résultat final diminuée de 1 (on part
' d'un indice 0 pour la 1re colonne
j = (1 + (Brv(i, 5) = "BIOLOGIQUE")) * 2
j = j + 2 + (Brv(i, 4) = "PRÊT")
'Les clés des éléments dico qu'on va créer sont les noms de Centres (on l'a en k)
'On teste donc si l'élément n'existe pas, auquel cas on lui affecte un tableau
' initial dont le 1er élément est également le nom du Centre, et les 5 éléments
' qui suivent, cinq 0 [on peut affecter un tableau comme valeur d'élément dico]
If Not d.exists(k) Then d(k) = Array(k, 0, 0, 0, 0, 0)
'Que l'élément préexistait ou qu'il vienne d'être créé, on recueille sa valeur
' (un tableau) dans la variable Tmp, on augmente l'élément de ce tableau
' correspondant à la colonne calculée de 1, et l'élément final (total) de 1,
' et on réaffecte le tableau modifié à l'élément dico
Tmp = d(k): Tmp(j) = Tmp(j) + 1: Tmp(5) = Tmp(5) + 1: d(k) = Tmp
End If
Next i
'Une fois tous les éléments dico créés et modifiés au fil du parcours des lignes
' pour incrémenter le nombre de rendez-vous selon ses caractéristiques, on affecte
' la totalité des valeurs (ou items) de dico au tableau Tmp, lequel sera alors un
' tableau à une dimension dont chaque élément est constitué par un tableau
Tmp = d.items
'on passe maintenant sur la feuille 'state' (sans bouger ! la feuille sur laquelle
' figure le bouton de lancement demeurera la feuille active jusqu'à la fin) et on
' cible la cellule A3 (la cellule de ton choix)
With Worksheets("state").Range("A3")
'On commence par éliminer la 'région courante' de A3, soit tout tableau antérieur
.CurrentRegion.Clear
'On rajuste notre cible à partir de A3 pour viser une plage de 2 lignes et 6 colonnes
' où se situera l'en-tête de notre tableau résultats
With .Resize(2, 6)
'On affecte les valeurs de cette plage (qui est vide) à une variable RTt, on obtient
' ainsi un tableau qui va nous servir à le garnir des mentions d'en-tête, ce qu'on fait
ETt = .Value
ETt(1, 1) = a: ETt(1, 2) = "BIOLOGIQUE": ETt(1, 4) = "RADIOLOGIQUE"
ETt(2, 2) = "PRÊT": ETt(2, 3) = "DON": ETt(2, 4) = ETt(2, 2)
ETt(2, 5) = ETt(2, 3): ETt(2, 6) = "Total"
'Et on réaffecte ce tableau à la plage
.Value = ETt
' qu'on met ensuite en forme : centrage, fusions de cellules, bordures
.HorizontalAlignment = xlCenter
For i = 2 To 4 Step 2
.Cells(1, i).Resize(, 2).Merge
Next i
.Borders.Weight = xlThin
End With
'On passe aux données comptabilisées, et on cible alors à partir de A3
' une plage décalée de 2 lignes et redimensionnée en nb de lignes au nb
' d'éléments dico, et 6 colonnes
With .Offset(2).Resize(d.Count, 6)
'On affecte notre tableau Tmp à la plage ainsi définie, ce qui se réalise
' compte tenu de sa constitution (tableau unidimensionnel de tableaux) par
' une double transposition, qui aboutit à placer les données comme on le
' souhaite dans la plage
.Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(Tmp))
'On procède à une mise en forme, comme précédemment : centrage (sauf 1re col.),
' bordures
.Offset(, 1).Resize(, 5).HorizontalAlignment = xlCenter
.Borders.Weight = xlThin
'Tri pour remettre les Centres dans l'ordre alphabétique
.Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlNo
End With
'On cible maintenant (toujours à partir de A3) une cellule décalée du nombre de
' lignes déjà utilisées (nb éléments dico-Centres + 2-en-tête) qu'on redimensionne
' sur 6 colonnes pour constituer la ligne de totaux
With .Offset(d.Count + 2).Resize(, 6)
'Mention 'Total' dans la 1re cellule et mise en forme : centrage (sauf première),
' bordures
.Cells(1, 1) = "Total"
.Offset(, 1).Resize(, 5).HorizontalAlignment = xlCenter
.Borders.Weight = xlThin
'Puis on calcule les totaux de chaque colonne pour les affecter à cheque cellule
' (sauf la 1re)
For i = 2 To 6
.Cells(1, i) = WorksheetFunction.Sum(.Offset(-d.Count, i - 1).Resize(d.Count, 1))
Next i
End With
'On active la feuille pour montrer les résultats à l'utilisateur (on est en train
' d'opérer dans une plage, .Worksheet nous renvoie la feuille parente de la plage)
.Worksheet.Activate
End With
'On décharge le Userform
Unload Me
End SubCordialement.
merci a vous et a bien tôt.
Merci aussi car c'est très enrichissant pour moi aussi.