Comment utiliser un algorithme deja existant sur excel
Résolu
kisscool527
Messages postés
3
Statut
Membre
-
ccm81 Messages postés 11033 Statut Membre -
ccm81 Messages postés 11033 Statut Membre -
Bonjour,
Je suis ergothérapeute et j'ai besoin pour ma pratique d'utilise un algorithme particulier (parut au Journal officiel de la République française) qui permet de calculer le degré de dépendance des personnes agées (calcule du GIR)
j'ai trouver l'algorithme sur internet, j'ai créé une grille pour entrer les informations de base nécessaires pour utiliser l'algorithme. Et c'est la que je suis complètement dépassé, je n'arriver pas à utiliser cet algorithme. je suis entré dans visual basic et je comprend rien!
les résultat de mon tableau excel présente une série de 8 lettres variables (soit A, soit B, soit C)
et je voudrai appliqué la formule pour me pondre un résultat qui se présenterait sous la forme d'un nombre entier compri entre 1 et 6 compris.
voici le lien pour voir l'algorithme : http://www.bevernage.com/geronto/Programe.htm
si quelqu'un pourrai m'aider ça me rendrai un grand service (et aux personnes agées dépendantes de votre entourage ;-))
Merci d'avance!
Florian
Je suis ergothérapeute et j'ai besoin pour ma pratique d'utilise un algorithme particulier (parut au Journal officiel de la République française) qui permet de calculer le degré de dépendance des personnes agées (calcule du GIR)
j'ai trouver l'algorithme sur internet, j'ai créé une grille pour entrer les informations de base nécessaires pour utiliser l'algorithme. Et c'est la que je suis complètement dépassé, je n'arriver pas à utiliser cet algorithme. je suis entré dans visual basic et je comprend rien!
les résultat de mon tableau excel présente une série de 8 lettres variables (soit A, soit B, soit C)
et je voudrai appliqué la formule pour me pondre un résultat qui se présenterait sous la forme d'un nombre entier compri entre 1 et 6 compris.
voici le lien pour voir l'algorithme : http://www.bevernage.com/geronto/Programe.htm
si quelqu'un pourrai m'aider ça me rendrai un grand service (et aux personnes agées dépendantes de votre entourage ;-))
Merci d'avance!
Florian
4 réponses
-
-
Bonjour
Ouvrir le document Excel
[ALT] + [F11]
Dans arborescence à gauche : Clic-droit > inséré un module
Double-Clic sur le "Module1"
Coller dans la fenêtre :
Function GIR (UneChaine As Variant) As Integer 'Mise à jour du 31/3/1999 If Len(UneChaine) < 8 Then GIR = 0 Exit Function End If 'Teste UneChaine pour le groupe A groupe = 0 If Left$(UneChaine, 1) = "C" Then groupe = 2000 If Mid$(UneChaine, 2, 1) = "C" Then groupe = groupe + 1200 If Mid$(UneChaine, 3, 1) = "C" Then groupe = groupe + 40 If Mid$(UneChaine, 4, 1) = "C" Then groupe = groupe + 40 If Mid$(UneChaine, 5, 1) = "C" Then groupe = groupe + 60 If Mid$(UneChaine, 6, 1) = "C" Then groupe = groupe + 100 If Mid$(UneChaine, 7, 1) = "C" Then groupe = groupe + 800 If Mid$(UneChaine, 8, 1) = "C" Then groupe = groupe + 200 If Mid$(UneChaine, 3, 1) = "B" Then groupe = groupe + 16 If Mid$(UneChaine, 4, 1) = "B" Then groupe = groupe + 16 If Mid$(UneChaine, 5, 1) = "B" Then groupe = groupe + 20 If Mid$(UneChaine, 6, 1) = "B" Then groupe = groupe + 16 If Mid$(UneChaine, 7, 1) = "B" Then groupe = groupe + 120 If Mid$(UneChaine, 8, 1) = "B" Then groupe = groupe + 32 'Rang groupe A Select Case groupe Case Is >= 4380 Rang = 1 Case 4140 To 4379 Rang = 2 Case 3390 To 4139 Rang = 3 End Select If Rang <> 0 GoTo GIR '------LIRE If Rang 'différent de' 0 ... ' 'Teste Une Chaine pour le groupe B groupe = 0 If Left$(UneChaine, 1) = "C" Then groupe = 1500 If Mid$(UneChaine, 2, 1) = "C" Then groupe = groupe + 1200 If Mid$(UneChaine, 3, 1) = "C" Then groupe = groupe + 40 If Mid$(UneChaine, 4, 1) = "C" Then groupe = groupe + 40 If Mid$(UneChaine, 5, 1) = "C" Then groupe = groupe + 60 If Mid$(UneChaine, 6, 1) = "C" Then groupe = groupe + 100 If Mid$(UneChaine, 7, 1) = "C" Then groupe = groupe + 800 If Mid$(UneChaine, 8, 1) = "C" Then groupe = groupe - 80 If Left$(UneChaine, 1) = "B" Then groupe = groupe + 320 If Mid$(UneChaine, 2, 1) = "B" Then groupe = groupe + 120 If Mid$(UneChaine, 3, 1) = "B" Then groupe = groupe + 16 If Mid$(UneChaine, 4, 1) = "B" Then groupe = groupe + 16 If Mid$(UneChaine, 5, 1) = "B" Then groupe = groupe + 0 If Mid$(UneChaine, 6, 1) = "B" Then groupe = groupe + 16 If Mid$(UneChaine, 7, 1) = "B" Then groupe = groupe + 120 If Mid$(UneChaine, 8, 1) = "B" Then groupe = groupe - 40 'Rang groupe B If groupe >= 2016 Then Rang = 4: GoTo GIR Else Rang = 0 End If 'Teste Une Chaine pour le groupe C groupe = 0 If Mid$(UneChaine, 3, 1) = "C" Then groupe = groupe + 40 If Mid$(UneChaine, 4, 1) = "C" Then groupe = groupe + 40 If Mid$(UneChaine, 5, 1) = "C" Then groupe = groupe + 60 If Mid$(UneChaine, 6, 1) = "C" Then groupe = groupe + 160 If Mid$(UneChaine, 7, 1) = "C" Then groupe = groupe + 1000 If Mid$(UneChaine, 8, 1) = "C" Then groupe = groupe + 400 If Mid$(UneChaine, 3, 1) = "B" Then groupe = groupe + 16 If Mid$(UneChaine, 4, 1) = "B" Then groupe = groupe + 16 If Mid$(UneChaine, 5, 1) = "B" Then groupe = groupe + 20 If Mid$(UneChaine, 6, 1) = "B" Then groupe = groupe + 20 If Mid$(UneChaine, 7, 1) = "B" Then groupe = groupe + 200 If Mid$(UneChaine, 8, 1) = "B" Then groupe = groupe + 40 'Rang groupe C Select Case groupe Case Is >= 1700 Rang = 5 Case 1432 To 1699 Rang = 6 End Select If Rang <> 0 GoTo GIR '------LIRE If Rang 'différent de' 0 ... 'Teste Une Chaine pour le groupe D groupe = 0 If Mid$(UneChaine, 5, 1) = "C" Then groupe = groupe + 2000 If Mid$(UneChaine, 6, 1) = "C" Then groupe = groupe + 400 If Mid$(UneChaine, 7, 1) = "C" Then groupe = groupe + 2000 If Mid$(UneChaine, 8, 1) = "C" Then groupe = groupe + 200 If Mid$(UneChaine, 5, 1) = "B" Then groupe = groupe + 200 If Mid$(UneChaine, 6, 1) = "B" Then groupe = groupe + 200 If Mid$(UneChaine, 7, 1) = "B" Then groupe = groupe + 200 'Rang groupe D If groupe >= 2400 Then Rang = 7: GoTo GIR Else Rang = 0 End If 'Teste Une Chaine pour le groupe E groupe = 0 If Left$(UneChaine, 1) = "C" Then groupe = 400 If Mid$(UneChaine, 2, 1) = "C" Then groupe = groupe + 400 If Mid$(UneChaine, 3, 1) = "C" Then groupe = groupe + 400 If Mid$(UneChaine, 4, 1) = "C" Then groupe = groupe + 400 If Mid$(UneChaine, 5, 1) = "C" Then groupe = groupe + 400 If Mid$(UneChaine, 6, 1) = "C" Then groupe = groupe + 800 If Mid$(UneChaine, 7, 1) = "C" Then groupe = groupe + 800 If Mid$(UneChaine, 8, 1) = "C" Then groupe = groupe + 200 If Mid$(UneChaine, 3, 1) = "B" Then groupe = groupe + 100 If Mid$(UneChaine, 4, 1) = "B" Then groupe = groupe + 100 If Mid$(UneChaine, 5, 1) = "B" Then groupe = groupe + 100 If Mid$(UneChaine, 6, 1) = "B" Then groupe = groupe + 100 If Mid$(UneChaine, 7, 1) = "B" Then groupe = groupe + 100 'Rang groupe E If groupe >= 1200 Then Rang = 8: GoTo GIR Else Rang = 0 End If 'Teste Une Chaine pour le groupe F groupe = 0 If Left$(UneChaine, 1) = "C" Then groupe = 200 If Mid$(UneChaine, 2, 1) = "C" Then groupe = groupe + 200 If Mid$(UneChaine, 3, 1) = "C" Then groupe = groupe + 500 If Mid$(UneChaine, 4, 1) = "C" Then groupe = groupe + 500 If Mid$(UneChaine, 5, 1) = "C" Then groupe = groupe + 500 If Mid$(UneChaine, 6, 1) = "C" Then groupe = groupe + 500 If Mid$(UneChaine, 7, 1) = "C" Then groupe = groupe + 500 If Mid$(UneChaine, 8, 1) = "C" Then groupe = groupe + 200 If Left$(UneChaine, 1) = "B" Then groupe = groupe + 100 If Mid$(UneChaine, 2, 1) = "B" Then groupe = groupe + 100 If Mid$(UneChaine, 3, 1) = "B" Then groupe = groupe + 100 If Mid$(UneChaine, 4, 1) = "B" Then groupe = groupe + 100 If Mid$(UneChaine, 5, 1) = "B" Then groupe = groupe + 100 If Mid$(UneChaine, 6, 1) = "B" Then groupe = groupe + 100 If Mid$(UneChaine, 7, 1) = "B" Then groupe = groupe + 100 'Rang groupe F If groupe >= 800 Then Rang = 9: GoTo GIR Else Rang = 0 End If 'Teste Une Chaine pour le groupe G groupe = 0 If Left$(UneChaine, 1) = "C" Then groupe = 150 If Mid$(UneChaine, 2, 1) = "C" Then groupe = groupe + 150 If Mid$(UneChaine, 3, 1) = "C" Then groupe = groupe + 300 If Mid$(UneChaine, 4, 1) = "C" Then groupe = groupe + 300 If Mid$(UneChaine, 5, 1) = "C" Then groupe = groupe + 500 If Mid$(UneChaine, 6, 1) = "C" Then groupe = groupe + 500 If Mid$(UneChaine, 7, 1) = "C" Then groupe = groupe + 400 If Mid$(UneChaine, 8, 1) = "C" Then groupe = groupe + 200 If Mid$(UneChaine, 3, 1) = "B" Then groupe = groupe + 200 If Mid$(UneChaine, 4, 1) = "B" Then groupe = groupe + 200 If Mid$(UneChaine, 5, 1) = "B" Then groupe = groupe + 200 If Mid$(UneChaine, 6, 1) = "B" Then groupe = groupe + 200 If Mid$(UneChaine, 7, 1) = "B" Then groupe = groupe + 200 If Mid$(UneChaine, 8, 1) = "B" Then groupe = groupe + 100 'Rang groupe G If groupe >= 650 Then Rang = 10: GoTo GIR Else Rang = 0 End If 'Teste Une Chaine pour le groupe H groupe = 0 If Mid$(UneChaine, 3, 1) = "C" Then groupe = groupe + 3000 If Mid$(UneChaine, 4, 1) = "C" Then groupe = groupe + 3000 If Mid$(UneChaine, 5, 1) = "C" Then groupe = groupe + 3000 If Mid$(UneChaine, 6, 1) = "C" Then groupe = groupe + 3000 If Mid$(UneChaine, 7, 1) = "C" Then groupe = groupe + 1000 If Mid$(UneChaine, 8, 1) = "C" Then groupe = groupe + 1000 If Mid$(UneChaine, 3, 1) = "B" Then groupe = groupe + 2000 If Mid$(UneChaine, 4, 1) = "B" Then groupe = groupe + 2000 If Mid$(UneChaine, 5, 1) = "B" Then groupe = groupe + 2000 If Mid$(UneChaine, 6, 1) = "B" Then groupe = groupe + 2000 If Mid$(UneChaine, 7, 1) = "B" Then groupe = groupe + 2000 If Mid$(UneChaine, 8, 1) = "B" Then groupe = groupe + 1000 'Rang groupe H Select Case groupe Case Is >= 4000 Rang = 11 Case 2000 To 3999 Rang = 12 Case Is < 2000 Rang = 13 End Select GoTo GIR GIR: Select Case Rang Case Is = 1 GIR = 1 Case 2 To 7 GIR = 2 Case 8 To 9 GIR = 3 Case 10 To 11 GIR = 4 Case 12 GIR = 5 Case 13 GIR = 6 End Select End Function
Fermer la fenêtre de Visual Basic.
Dans un cellule écrire=GIR("Variable")
"Variable" est = à votre série de 8 lettre.
La formule renvoie un nombre entre 1 et 6.
*Pensez mettre vos messages en [Résolu] et cliquer sur le + des conseil qui vous ont été utils" -
Merci beaucoup les infos,
tout fonctionne parfaitement!
votre réactivité est impresionante en tout cas!! :-)
bonne après-midi!
Florian -
De rien aussi,
Peux tu mettre le sujet à Résolu (en haut à droite de ton premier message)
Bonne fin de journée
Cordiales salutations à skk201 au passage
ccm81
