Synthèse et amélioration du code (Code court)
Bonjour à tous,
J’espère que vous allez bien,
Dans mon premier fichier en pièce jointe nommée "code court", j'ai une feuille nommée "INDEX" qui possède un bouton nommé "GO". Ce bouton permet de faire la synthèse des données statistiques de certaines pathologies des patients (en fonction de leur âge).
Les données sont stockées sur la feuille LISTE PATIENTS et la synthèse dans la feuille BILAN JOURNALIER.
Jusque-là tout vas bien.
Le souci est que ce code est super long (voir code ci-dessous) et vu qu’il y’a plusieurs pathologie à compter, j’aimerai savoir les choses suivantes :
- (1) Est-il possible de faire un code PLUS COURT mais qui donnera le même résultat ?
- (2) Vu qu’il y’a plusieurs pathologie à compter (voir feuille LISTE PATIENTS, colonne G), est-il possible de faire un code qui va tous les englober ?
J’ai tout tenté et j’ai la tête qui chauffe depuis hier soir, raison pour laquelle je me tourne à nouveau vers vous.
En vous remerciant de votre aide s’il vous plait.
Dans l’attente vos retour,
Cordialement
NB : le code en question :
Sub Open_BTN_CONSULTATION()
'*** <=== 0-11 mois
'Femmes (+)
Sheets("BILAN JOURNALIER").Range("d11") = Application.CountIfs(Worksheets("LISTE PATIENTS").Range("d2:d100"), "F", _
Worksheets("LISTE PATIENTS").Range("g2:g100"), "Nouveaux cas consultés référés", _
Worksheets("LISTE PATIENTS").Range("h2:h100"), "CAS CONSULTÉS", _
Worksheets("LISTE PATIENTS").Range("e2:e100"), ">01/01/2024")
'Hommes (+)
Sheets("BILAN JOURNALIER").Range("c11") = Application.CountIfs(Worksheets("LISTE PATIENTS").Range("d2:d100"), "M", _
Worksheets("LISTE PATIENTS").Range("g2:g100"), "Nouveaux cas consultés référés", _
Worksheets("LISTE PATIENTS").Range("h2:h100"), "CAS CONSULTÉS", _
Worksheets("LISTE PATIENTS").Range("e2:e100"), ">01/01/2024")
'*** <=== 1-4 Ans
Dim startdate As Date, endDate As Date
startdate = "01/01/2021" '<=== date la plus ancienne
endDate = "31/12/2025" '<=== date la plus récente
'Femmes (+)
Sheets("BILAN JOURNALIER").Range("f11") = Application.CountIfs(Worksheets("LISTE PATIENTS").Range("d2:d100"), "F", _
Worksheets("LISTE PATIENTS").Range("g2:g100"), "Nouveaux cas consultés référés", _
Worksheets("LISTE PATIENTS").Range("h2:h100"), "CAS CONSULTÉS", _
Worksheets("LISTE PATIENTS").Range("e2:e100"), ">=" & CLng(startdate), _
Worksheets("LISTE PATIENTS").Range("e2:e100"), "<=" & CLng(endDate))
'Hommes (+)
Sheets("BILAN JOURNALIER").Range("e11") = Application.CountIfs(Worksheets("LISTE PATIENTS").Range("d2:d100"), "M", _
Worksheets("LISTE PATIENTS").Range("g2:g100"), "Nouveaux cas consultés référés", _
Worksheets("LISTE PATIENTS").Range("h2:h100"), "CAS CONSULTÉS", _
Worksheets("LISTE PATIENTS").Range("e2:e100"), ">=" & CLng(startdate), _
Worksheets("LISTE PATIENTS").Range("e2:e100"), "<=" & CLng(endDate))
'*** <=== 5-14 Ans
Dim start_5 As Date, end_14 As Date
start_5 = "01/01/2011" '<=== date la plus ancienne
end_14 = "12/12/2020" '<=== date la plus récente
'Femmes (+)
Sheets("BILAN JOURNALIER").Range("h11") = Application.CountIfs(Worksheets("LISTE PATIENTS").Range("d2:d100"), "F", _
Worksheets("LISTE PATIENTS").Range("g2:g100"), "Nouveaux cas consultés référés", _
Worksheets("LISTE PATIENTS").Range("h2:h100"), "CAS CONSULTÉS", _
Worksheets("LISTE PATIENTS").Range("e2:e100"), ">=" & CLng(start_5), _
Worksheets("LISTE PATIENTS").Range("e2:e100"), "<=" & CLng(end_14))
'Hommes (+)
Sheets("BILAN JOURNALIER").Range("g11") = Application.CountIfs(Worksheets("LISTE PATIENTS").Range("d2:d100"), "M", _
Worksheets("LISTE PATIENTS").Range("g2:g100"), "Nouveaux cas consultés référés", _
Worksheets("LISTE PATIENTS").Range("h2:h100"), "CAS CONSULTÉS", _
Worksheets("LISTE PATIENTS").Range("e2:e100"), ">=" & CLng(start_5), _
Worksheets("LISTE PATIENTS").Range("e2:e100"), "<=" & CLng(end_14))
'*** <=== 15-49 Ans
Dim start_15 As Date, end_49 As Date
start_15 = "01/01/1975" '<=== date la plus ancienne
end_49 = "12/12/2010" '<=== date la plus récente
'Femmes (+)
Sheets("BILAN JOURNALIER").Range("j11") = Application.CountIfs(Worksheets("LISTE PATIENTS").Range("d2:d100"), "F", _
Worksheets("LISTE PATIENTS").Range("g2:g100"), "Nouveaux cas consultés référés", _
Worksheets("LISTE PATIENTS").Range("h2:h100"), "CAS CONSULTÉS", _
Worksheets("LISTE PATIENTS").Range("e2:e100"), ">=" & CLng(start_15), _
Worksheets("LISTE PATIENTS").Range("e2:e100"), "<=" & CLng(end_49))
'Hommes (+)
Sheets("BILAN JOURNALIER").Range("i11") = Application.CountIfs(Worksheets("LISTE PATIENTS").Range("d2:d100"), "M", _
Worksheets("LISTE PATIENTS").Range("g2:g100"), "Nouveaux cas consultés référés", _
Worksheets("LISTE PATIENTS").Range("h2:h100"), "CAS CONSULTÉS", _
Worksheets("LISTE PATIENTS").Range("e2:e100"), ">=" & CLng(start_15), _
Worksheets("LISTE PATIENTS").Range("e2:e100"), "<=" & CLng(end_49))
'*** <=== >50 ans
'Femmes (+)
Sheets("BILAN JOURNALIER").Range("l11") = Application.CountIfs(Worksheets("LISTE PATIENTS").Range("d2:d100"), "F", _
Worksheets("LISTE PATIENTS").Range("g2:g100"), "Nouveaux cas consultés référés", _
Worksheets("LISTE PATIENTS").Range("h2:h100"), "CAS CONSULTÉS", _
Worksheets("LISTE PATIENTS").Range("e2:e100"), "<01/01/1975")
'Hommes (+)
Sheets("BILAN JOURNALIER").Range("k11") = Application.CountIfs(Worksheets("LISTE PATIENTS").Range("d2:d100"), "M", _
Worksheets("LISTE PATIENTS").Range("g2:g100"), "Nouveaux cas consultés référés", _
Worksheets("LISTE PATIENTS").Range("h2:h100"), "CAS CONSULTÉS", _
Worksheets("LISTE PATIENTS").Range("e2:e100"), "<01/01/1975")
Sheets("BILAN JOURNALIER").Select
Range("a2").Select 'Bascule sur la cellule "A2"
End SubBonsoir
Code simplifié à tester
Sub Open_BTN_CONSULTATION()
Dim ageRanges As Variant
Dim genders As Variant
Dim startDates As Variant
Dim endDates As Variant
Dim i As Integer
' Définir les plages d'âge et les dates
ageRanges = Array("0-11 mois", "1-4 Ans", "5-14 Ans", "15-49 Ans", ">50 ans")
genders = Array("F", "M")
startDates = Array("01/01/2024", "01/01/2021", "01/01/2011", "01/01/1975", "01/01/1975")
endDates = Array("01/01/2024", "31/12/2025", "12/12/2020", "12/12/2010", "31/12/9999") ' Utiliser une date future pour >50 ans
' Boucle à travers les plages d'âge
For i = 0 To UBound(ageRanges)
Dim colOffset As Integer
colOffset = i * 2
' Boucle à travers les genres
For j = 0 To UBound(genders)
Dim count As Long
Dim startDate As Date, endDate As Date
' Initialiser les dates pour les groupes d'âge
If ageRanges(i) = ">50 ans" Then
startDate = CDate(startDates(i))
endDate = CDate(endDates(i)) ' Pas de limite supérieure
count = Application.CountIfs(Worksheets("LISTE PATIENTS").Range("d2:d100"), genders(j), _
Worksheets("LISTE PATIENTS").Range("g2:g100"), "Nouveaux cas consultés référés", _
Worksheets("LISTE PATIENTS").Range("h2:h100"), "CAS CONSULTÉS", _
Worksheets("LISTE PATIENTS").Range("e2:e100"), "<" & startDate)
Else
startDate = CDate(startDates(i))
endDate = CDate(endDates(i))
count = Application.CountIfs(Worksheets("LISTE PATIENTS").Range("d2:d100"), genders(j), _
Worksheets("LISTE PATIENTS").Range("g2:g100"), "Nouveaux cas consultés référés", _
Worksheets("LISTE PATIENTS").Range("h2:h100"), "CAS CONSULTÉS", _
Worksheets("LISTE PATIENTS").Range("e2:e100"), ">=" & CLng(startDate), _
Worksheets("LISTE PATIENTS").Range("e2:e100"), "<=" & CLng(endDate))
End If
' Écriture des résultats dans la feuille de calcul
Sheets("BILAN JOURNALIER").Cells(11, 3 + colOffset + j).Value = count
Next j
Next i
' Sélectionner la cellule A2
Sheets("BILAN JOURNALIER").Select
Range("a2").Select
End SubBonjour,
personnellement je construirais un Userform dans lequel j'inscrirais des combobox (sexe, choix, pathomogie, date de naissance et âge). Je pourrrais ainsi déterminer en choississant les variables correspondantes dans ces ComboBox utiliser votre bout de code mais cette fois ci muni des variables adéquat
Est ce une bonne idée ? A voir
Bonjour à tous,
Jacky, Oui j'ai déjà conçu le Userform. Le code que je vous envoi c'est juste pour pas vous saturer.
Joco7915, merci, je teste et te reviens dans les plus brefs délais
Joco7915,j'ai pas bien compris ce commentaire stp ?
' Utiliser une date future pour >50 ansJoco7915, j’ai testé ton code et voici la conclusion :
- Dans la feuille LISTE PATIENTS, ligne 2, il un sujet de sexe masculin (M), qui est un « Nouveaux cas consultés référés » et qui a plus de 50 ans (cellule E2), mais ton code ne le compte pas
- Toujours dans la feuille LISTE PATIENTS, ligne 5 et 9, il y a deux sujets de sexe féminin (F), qui sont des « Nouveaux cas consultés référés » et qui ont moins de 11 mois car étant née en 2025 (colonne E), mais ton code ne le compte pas
- Enfin, toujours dans la feuille LISTE PATIENTS, il un sujet de sexe masculin (M), qui est un « Nouveaux cas consultés référés » et dont l’âge varie entre 15 et 49 ans car étant née le 01/03/2010 (cellule E12), mais ton code ne le compte pas non plus
Peux-tu revoir ça s’il te plaît ?
Je demande aussi l’aide de tous,
Dans l’attente de vos retours svp,
Cordialement
cousinhub,
Malheureusement je n'ai plus le temps ni la patience pour avoir Power Query.
Vba m'a pris 3 ans et même aujourd"jui, je ne suis toujours pas expert comme vous.
Bref,
Dans l’attente de vos retours svp,
Cordialement
Re-,
Ne pas avoir le temps, ni la patience, pour arriver à ses fins.... respect
3 ans après, tu ne maîtrises pas VBA... mais tu persistes, respect! VBA n'est pas "The" solution, juste une alternative...
Bon courage
cousinhub merci,
J'attends toujours vos retours svp,
Personne pour m'aider à simplifier mon code ?
désolé, mais l'userform que je te préconise je le vois pas alors que tu dis
Jacky, Oui j'ai déjà conçu le Userform. Le code que je vous envoi c'est juste pour pas vous saturer.Jacky, je l'ai dissocié du code pour pas alourdir le fichier.
5 min, je vous l'envoi
Jacky,
Ci-joint, le fichier vba avec le Userform.
Il suffit de cliquer sur le bouton GO de la feuille INDEX,
Merci d'avance pour votre aide.
Dans l'attente
Rhoooooo
Une pseudo "LEAD CONSEIL", qui vend ses produits, issus de solutions gratuites
Pitoyable....
cousinhub,
si tu as bien remarqué, je suis entrain de t'éviter depuis le début.
je ne te connais pas, je te respecte, donc s'il te plait, j'attends la même chose venant de ta part.
tu ne veux pas m'aider OK, mais pas la peine de venir m'insulter ou me dénigrer ici.
LEAD CONSEILS dont tu parles, c'est un fichier que j'ai pris sur internet il y a fort longtemps, j'ai pas trouvé utile de changer tout ça car je fais mes applications pour la structure de santé où je bosse, et j'essai de m'inspirer de ses codes afin de m'améliorer.
Maintenant "monsieur je sais tout", adepte de la science infuse, c'est la dernière fois que je te répond, car la prochaine fois, je serai très désagréable avec toi.
Yessssssssss
Mais pourquoi, tu évites toute solution autre, que celle que tu penses être "The" solution
Je t'ai proposé, à toute bonne foi, une autre alternative
Tu as pensé, avec ta vision, qu'elle ne pouvait pas être considérée
Reste dans ton obstination.... (mais essaie d'ouvrir ton esprit....)
Adieu
Bonsoir Past007,
il y a quelques heures j'ai regardé le fichier et à moins que je ne me trompe je me suis demandé pourquoi vous voulez faire un code VBA alors qu'une simple formule dans les cellules vous donne la même résultat
Crdlt
Dan,
Une formule Excel me donne le même résultat OK, mais j'aime le VBA car on peut relier le CODE dans un bouton, bouton qu'il suffira d'appuyer tout simplement ensuite.
Voici pourquoi je préfère du VBA.
Merci d'avance pour votre aide.
Dans l'attente
Une formule Excel me donne le même résultat OK, mais j'aime le VBA car on peut incluse le CODE dans un bouton, bouton qu'il suffira d'appuyer tout simplement ensuite.
Ben pourquoi se compliquer avec un bouton puisqu'excel va automatiquement vous donner le résultat. Là je ne comprends pas
Et ce d'autant que vous avez un tableau structuré
Vous changez ou ajouter dans la feuille Liste patients, et la feuille Bilan sera à jour.
Donc un feuille en moins, pas de codes et pas besoin de cliquer sur un bouton et surtout pas besoin d'aller modifier les lignes de code si changement
Une seule chose à faire c'est supprimer les lignes sans données dans votre tableau structuré.
Bonne règle est ne pas avoir de lignes sans données dans ce genre de tableau.
Après votre formule en C11 par exemple -->
=NB.SI.ENS(BaseRH[NOM];D$7;BaseRH[N° TELEPHONE];$B$11;BaseRH[SEXE];">01/01/2024")A tirer à droite pour D11
NB : si Cousinhub vous proposait de passer à Power Query, c'est justement le but suivi par Microsoft .... supprimer le VBA...
cousinhub,
si tu as bien remarqué, je suis entrain de t'éviter depuis le début.
je ne te connais pas, je te respecte, donc s'il te plait, j'attends la même chose venant de ta part.
tu ne veux pas m'aider OK, mais pas la peine de venir m'insulter ou me dénigrer ici.
LEAD CONSEILS dont tu parles, c'est un fichier que j'ai pris sur internet il y a fort longtemps, j'ai pas trouvé utile de changer tout ça car je fais mes applications pour la structure de santé où je bosse, et j'essai de m'inspirer de ses codes afin de m'améliorer.
Maintenant "monsieur je sais tout", adepte de la science infuse, c'est la dernière fois que je te répond, car la prochaine fois, je serai très désagréable avec toi.
Et moi, pendant c'temps là, j'tournais la manivelle....
Dan, avez-vous déjà travaillé dans une structure de santé qui fait dans du bénévolat ? Pire, travailler avec des gens qui ne s'y connaissent pas bien sur Excel ? C'est mon cas mon frère.
Donc mon boulot (j'ai été embaucher) consiste à développer des petites applications où ils n'auront pas trop de boulot ou de réflexion, d'où l'utilisation des boutons et du code VBA.
Mais j'apprécie beaucoup votre aide et je continue à chercher une solution VBA,
Merci encore encore