Comment utiliser un algorithme deja existant sur excel

Résolu
kisscool527 Messages postés 3 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
A voir également:

4 réponses

Réponse 1 / 4
ccm81 Messages postés 11033 Statut Membre 2 433
 
Bonjour

https://www.cjoint.com/?3GxlbTTeq1P

Cordialement
1
Réponse 2 / 4
skk201 Messages postés 942 Date d'inscription   Statut Membre Dernière intervention   54
 
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"
1
Réponse 3 / 4
kisscool527 Messages postés 3 Statut Membre
 
Merci beaucoup les infos,
tout fonctionne parfaitement!

votre réactivité est impresionante en tout cas!! :-)

bonne après-midi!

Florian
0
skk201 Messages postés 942 Date d'inscription   Statut Membre Dernière intervention   54
 
De rien.
0
Réponse 4 / 4
ccm81 Messages postés 11033 Statut Membre 2 433
 
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
0