Gestion "agenda" patients - problème vba

  • Initiateur de la discussion Initiateur de la discussion Guims
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

G

Guims

Guest
Bonjour à tous,

Je situe un peu mon problème...

J'ai un répertoire avec un fichier par patient.
J'ai un fichier avec un onglet par mois qui reprend les patients (max 15 par jour) qui ont été soignés.

Je voudrais créer une macro qui check si la date x est "contenue" entre la date d'entrée et de sortie du patient (dans l'onglet données du fichier patient) et tape le nom prénom et num sur la ligne de la date x.
Puis passer à la date y (x+1)...
etc...
voir mes fichiers exemples

Merci de votre aide

Guillaume
 

Pièces jointes

Re "Guillaume"
en relisant le post je viens de m'apercevoir que j'ai pris en compte les dates d'entrée et de sortie
il suffit pour régler ce problème de supprimer les = dans la procédure on obtient ainsi:
If VdateCal > VdateDebut And VdateCal < VdateFin Then
A+++
Jean Marie
 
re "Guillaume"
je joins le code avec un ajout en Gras
tu peux aussi ajouter un bouton en page patient et y coller la macro
Sub transfertNom()
Dim cel As Range
Dim VdateCal As Long, VdateDebut As Long, VdateFin As Long
Dim Tab1 As Variant, Tab2 As Variant, Tab3 As Variant
Dim derlgn As Byte, derlgn2 As Byte, lgn As Byte, nCol As Byte, nPatient As Integer
Application.ScreenUpdating = False
With Workbooks("patientx").Sheets("Données")
.Activate
derlgn = .Range("B65536").End(xlUp).Row

Tab1 = .Range("B12:I" & derlgn).Value
nPatient = UBound(Tab1, 1)
End With
With Workbooks("journal_kine").Sheets("Janvier")
.Activate
.Range("B3😛33").ClearContents'efface la zone avant réinscription si modif en page patient
derlgn2 = .Range("A65536").End(xlUp).Row
nCol = 1
For nPatient = 1 To UBound(Tab1, 1)

For Each cel In .Range("A3:A" & derlgn2)


VdateCal = Format(cel.Value, "00000")
VdateDebut = Format(Tab1(nPatient, 6), "00000")
VdateFin = Format(Tab1(nPatient, 8), "00000")


If VdateCal > VdateDebut And VdateCal < VdateFin Then
cel.Offset(0, nCol) = Tab1(nPatient, 1) & "-" & Tab1(nPatient, 5)

End If

Next
nCol = nCol + 1
Next

End With
Application.ScreenUpdating = True
End Sub

A+++
Jean Marie
 
C'est génial ChTi'160 !!! Merci beaucoup !!!
Je viens de rentrer du boulot c'est pour cela que je n'ai pu te répondre plus tot.

Pour ta 1ere modif (avec les dates d'entrées et de sorties), je ne comprends la modif justement puisque les jours d'entree et de sortie comptent également (donc le "=" est bien !)

En tout cas, chapeau! ca tourne impec !

(je débute en vba et je tatonne un peu, tu m'as donc méchamment avancé !! encore merci !)

@+
Guillaume
 
Re-chti,
je viens d'essayer avec la base de données patients (la vraie),
le problème c'est que, en moyenne, il y a 75 patients par mois, donc 75 colonnes... ce qui fait beaucoup car c'est un document qui est destiné à être imprimé...
Quelle modif peut etre faite pour que les patients se mettent l'un à la suite de l'autre par jour (dans ton fichier exemple, que le 8 janvier par exemple, "JEAN - 124567" soit à cote de "gus-123456"...

merci de ton aide et de ta patience !

@ +
Guillaume
 
BOnjour le forum
salut ChTi

Juste avant de partir au boulot, une petite question :
le fichier journal doit etre realise avec un onglet par mois, est ce que je dois modifier la macro pour en créer 12 (1 par mois) ou peut on créer une loop pour qu'elle (la macro) change d'onglet donc de mois seule ?

merci de votre aide !

BOnne journée !

Guillaume
 
Salut"Guillaume"
Bonjour le"FORUM"
une version 4 qui avec l'introduction d'une variable mois (qui prend la valeur du mois en cours) ouvre la feuille portant le nom du mois
Tiens moi au courant
A+++
Jean Marie
 

Pièces jointes

Salut ChTi !
Ca marche impec mais pas encore comme il faudrait...
si un patient reste du 27/01/05 au 3/02/05, il faudrait que la macro
écrive sur l'onglet janvier et février (pas seulement sur le mois en cours)

merci de ton aide

Guillaume
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
3
Affichages
361
Réponses
1
Affichages
398
Réponses
14
Affichages
1 K
Retour