Alphanumérisation

Bonsoir à tous,

Suite a des recherches infructueuses depuis quelques jours sur le net, je me permets de poster ma demande concernant un tableau d'alphanumérisation que j'aimerais mettre en place.

Je ne sais pas s'il faut utiliser une macro ou une formule classique pour ma demande.

Ma demande :

Chaque lettre a un chiffre/nombre propre qui lui est attribuée (A=1, B=2, C=3…..Z=26).

Par exemple pour le mot "Lundi" le résultat de la somme des chiffres/nombres propres à chaque lettre du mot "Lundi" est : 12+21+14+4+9 = 60.

Est il donc possible d'obtenir directement le résultat au sein d'une cellule sans passer par la décomposition du mot lettre par lettre? Et si oui…. comment ?

Et est il possible d'automatiser cette formule/macro ?

Si ma demande n'est pas claire, je vous joins en pièce jointe un fichier excel.

Merci d'avance pour votre aide.

Bonsoir,

Avec une fonction perso. A mettre dans un module standard :

Function TOTAL_LETTRES(Cel As Range) As Long

    Dim Total As Long
    Dim I As Long
    Dim Texte As String

    Application.Volatile

    Texte = Cel.Value

    Texte = RemplacerAccent(Texte)

    For I = 1 To Len(Texte)

        Total = Total + Asc(UCase(Mid(Texte, I, 1))) - 64

    Next I

    TOTAL_LETTRES = Total

End Function

'fonction privée pour suppression des accents, non exhaustive, à compléter !
Private Function RemplacerAccent(Chaine As String) As String

    Dim I As Long

    Chaine = Replace(Chaine, "à", "a")
    Chaine = Replace(Chaine, "â", "a")
    Chaine = Replace(Chaine, "ä", "a")

    Chaine = Replace(Chaine, "é", "e")
    Chaine = Replace(Chaine, "è", "e")
    Chaine = Replace(Chaine, "ê", "e")
    Chaine = Replace(Chaine, "ë", "e")

    Chaine = Replace(Chaine, "î", "i")
    Chaine = Replace(Chaine, "ï", "i")

    Chaine = Replace(Chaine, "ô", "o")
    Chaine = Replace(Chaine, "ö", "o")

    Chaine = Replace(Chaine, "ù", "u")
    Chaine = Replace(Chaine, "û", "u")
    Chaine = Replace(Chaine, "ü", "u")

    Chaine = Replace(Chaine, "ç", "c")

    RemplacerAccent = Chaine

End Function

et appeler dans une feuille de calcul de cette façon :

=TOTAL_LETTRES(D4)

Le module contient une fonction privée (non visible depuis Excel) appelée par la fonction "TOTAL_LETTRES " pour supprimer les accents et cédilles !

Hervé.

Bonsoir,

une solution avec une formule matricielle (à valider par ctrl-maj-entrée), pour un mot en A1.

=SOMME(CODE(STXT(MAJUSCULE(A1) & REPT("@";20);LIGNE(1:20);1))-64)

Bonjour Hervé.,

Merci pour la rapidité et la clarté de ta réponse.

Juste une petite question cependant: Est il possible d'adapter ce code pour prendre en compte les espaces les apostrophes et les tirets (mot composés) comme étant égal à zéro? (J'ai oublié de préciser ce point dans ma demande .

Exemple :

Le chat = 12 + 5 + 0(l'espace) + 3 + 8 + 1 + 20 = 49

J'ai essayé de comprendre ton code afin de rajouter cette condition mais je ne comprends pas comment tu as fais pour prendre en compte mon tableau d'alphanumérisation.... (J'apprends en parallèle le VBA).

Merci Hervé.

h2so4,

Merci pour ta formule, je la garde sous le coude

Bonsoir,

A la fonction "RemplacerAccent" il te faut rajouter les lignes :

Chaine = Replace(Chaine, " ", "")
Chaine = Replace(Chaine, "'", "")
Chaine = Replace(Chaine, "-", "")

donc, la fonction devient :

Private Function RemplacerAccent(Chaine As String) As String

    Dim I As Long

    Chaine = Replace(Chaine, "à", "a")
    Chaine = Replace(Chaine, "â", "a")
    Chaine = Replace(Chaine, "ä", "a")

    Chaine = Replace(Chaine, "é", "e")
    Chaine = Replace(Chaine, "è", "e")
    Chaine = Replace(Chaine, "ê", "e")
    Chaine = Replace(Chaine, "ë", "e")

    Chaine = Replace(Chaine, "î", "i")
    Chaine = Replace(Chaine, "ï", "i")

    Chaine = Replace(Chaine, "ô", "o")
    Chaine = Replace(Chaine, "ö", "o")

    Chaine = Replace(Chaine, "ù", "u")
    Chaine = Replace(Chaine, "û", "u")
    Chaine = Replace(Chaine, "ü", "u")

    Chaine = Replace(Chaine, "ç", "c")

    Chaine = Replace(Chaine, " ", "")
    Chaine = Replace(Chaine, "'", "")
    Chaine = Replace(Chaine, "-", "")

    RemplacerAccent = Chaine

End Function

Hervé.

La solution était logique mais encore fallait il y penser (j'ai encore du boulot). Merci Hervé !

J'ai remarqué que ton code fonctionne parfaitement même si je supprime le tableau d'alphanumérisation de base 1 dans le tableur excel.

Cependant j'ai une question un peu plus délicate et je penses complexe (désolé j'affine ma demande en fonction du résultat obtenu) :

Je peux utiliser ton code pour des déclinaisons proportionnelles (base 2,3, etc....). Mais comment puis je procéder quand la proportion d'une table n'est pas respecté.

Je te donnes un exemple :

De A à J : incrémentation de 1 à chaque nouvelle lettre (A=1, B=2,C=3,......J=10)

De K à S : incrémentation de 10 (K=20, L=30, M=40...S=100)

De T à Z : incrémentation de 100 (T=200, U=300, V= 400.....Z=800)

Je te remercie pour ton aide et ta disponibilité.

Fred