VBA et numérologie

Bonjour,
Juste au passage, admis le nombre dans cellule « B1 » et dans « B2 » cette fonction personalisée :

=adres1et9(B1)

Mettre dans un module cette fonction :

Function adres1et9(nb)
a = nb
suite:
ad = 0
For c = 1 To Len(a)
    ad = ad + CInt(Mid(a, c, 1))
Next c
If Len(ad) > 1 Then
    a = ad
    GoTo suite
End If
adres1et9 = ad
End Function

Bonjour,

en A1
Michel

en B1 :
=Numerologie(A1)

Avec cette fonction :

Option Explicit
Function Numerologie(ByVal s As String) As Integer
Dim i As Integer
Dim n As Integer
  s = UCase(s)
  For i = 1 To Len(s)
    n = n + 1 + ((Asc(Mid(s, i, 1)) - 65) Mod 9)
  Next i
  s = n: n = 0
  For i = 1 To Len(s)
    n = n + Val(Mid(s, i, 1))
  Next i
  Numerologie = n
End Function

Sub test()
  MsgBox Numerologie("Michel")
End Sub

Bonjour à tous,

une version par formule :

=MOD(SOMMEPROD(CODE(STXT(MAJUSCULE(A1);LIGNE(INDIRECT("$1:$"&NBCAR(A1)));1))-64);9)

eric

Re,

@Eric, bien vu le Mod 9 !!!

Ça simplifie ma fonction :

Option Explicit
Function Numerologie(ByVal s As String) As Integer
Dim i As Integer
Dim n As Integer
  s = UCase(s)
  For i = 1 To Len(s)
    n = n + 1 + (Asc(Mid(s, i, 1)) - 65) Mod 9
  Next i
  Numerologie = 1 + (n - 1) Mod 9
End Function

Finalement :

Option Explicit
Function Numerologie(ByVal s As String) As Variant
Dim i As Integer
Dim n As Integer
  s = UCase(supprAccents(s))
  For i = 1 To Len(s)
    n = n + 1 + (Asc(Mid(s, i, 1)) - 65) Mod 9
  Next i
  Select Case n
    Case 11
      Numerologie = "11/2"
    Case 22
      Numerologie = "22/4"
    Case 33
      Numerologie = "33/6"
    Case Else
      Numerologie = 1 + (n - 1) Mod 9
  End Select
End Function
Function supprAccents(txt As String) As String
Dim s As String
Dim i As Long
Const a$ = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const b$ = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
  s = txt
  For i = 1 To Len(a)
    s = Replace(s, Mid(a, i, 1), Mid(b, i, 1))
  Next
  supprAccents = s
End Function

Explications:
1. supprimer les accents avec supprAccents
2. mettre le texte en majuscules avec UCase
3. Faire la somme des valeurs de chaque lettre avec une boucle et MOD
4. traiter les cas particulier

Conversion des lettres en valeurs :
- le code Ascii des lettres de A à Z ont pour valeur 65 à 90
- en enlevant 65 ça va de 0 à 35
- la fonction MOD donne le reste de la division (ici par 9) soit 0 à 8 pour A à I, 0 à 8 pour J à R et 0 à 7 pour S à Z. En ajoutant 1 à chaque valeur on obtient la valeur cherchée de 1 pour A à 8 pour Z

Ah, vos réponses et toutes ces formules encore obscures me font penser que c'est une montagne presque insurmontable, et en même temps plus je la gravis plus j'aime bien !
Après ce message, je file dans le VBE pour essayer de piger les commandes que je ne comprends pas.

Tout d'abord merci, que ce soit pour les macros ou pour les formules.

Cela dit, il y a deux détails sur lesquels je n'ai pas trop insisté (parce que je pensais trouver une variable à répliquer ou adapter) :

1. Si j'ai bien tout compris, la macro de Patrice33740 remplace les lettres par des caractères Ascii puis les additionne entre eux pour arriver au résultat.
Or, ici, il y a des valeurs définies pour les lettres dont voici le détail exhaustif :
A , J , S = 1
B , K , T = 2
C , L , U = 3
D , M, V = 4
E , N , W = 5
F , O , X = 6
G , P , Y = 7
H , Q , Z = 8
I , R , = 9

2. Second point bloquant : lorsque la somme est de 2 chiffres (soit 99,99% des cas, peu de chances que ça atteigne 3 chiffres), avant que les deux chiffres s'additionnent entre eux, il faut un moyen de vérifier (elseif ?) qu'ils ne sont pas égaux à 11, 22 ou 33.
Si le cumul est égal à l'un de ces trois nombres, je dois afficher une autre valeur.
Sinon, obtenir un seul chiffre.

En "français", je suppose que le raisonnement ressemblerait à :
Pour chaque lettre A, J ou S, remplacer par 1
Pour chaque lettre B, K ou T remplacer par 2
... jusqu'à I, R = 9

Faire la somme de tous ces chiffres.
Si la somme est égale à 11, 22 ou 33, alors remplacer par 11/2, 22/4 ou 33/6
Si non, additionner les deux chiffres

J'espère avoir été le plus précis possible, d'avance merci !!

EDIT = Alors je ne sais pas comment c'est possible, et il faut que je fasse plus de tests, mais j'ai testé avec des espaces et sans espaces... Et les espaces foutent le bordel, si on les vire, on obtient bien les bons résultats. Donc la macro de Patrice33740 semblent parfaitement fonctionner pour la partie substitution... J'ai donc peut-être parlé trop vite, désolé !

EDIT 2 = Le retour du Edit (désolé)
Par la méthode Ascii, il y a une différence si on met les accents (ex : "Gérald" = 8 vs "Gerald" = 2)
Je me doute qu'il serait plus simple de faire une MFEC pour signaler qu'il y a un problème lorsqu'on met un accent, mais s'il est possible de l'intégrer ce serait plus flexible. Merci !

Sans les accents :

Option Explicit
Function Numerologie(ByVal s As String) As Double
Dim i As Integer
Dim n As Integer
  s = UCase(supprAccents(s))
  For i = 1 To Len(s)
    n = n + 1 + (Asc(Mid(s, i, 1)) - 65) Mod 9
  Next i
  Select Case n
    Case 11, 22, 33
      Numerologie = 5.5
    Case Else
      Numerologie = 1 + (n - 1) Mod 9
  End Select
End Function
Function supprAccents(txt As String) As String
Dim s As String
Dim i As Long
Const a$ = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const b$ = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
  s = txt
  For i = 1 To Len(a)
    s = Replace(s, Mid(a, i, 1), Mid(b, i, 1))
  Next
  supprAccents = s
End Function

Cordialement
Patrice

Personne ne peut détenir tout le savoir, c'est pour ça qu'on le partage.

Merci pour le retour mais je me permets de repréciser que je débute en VBA, j'en suis vraiment aux bases, la fonction Mod je ne la comprends qu'à moitié. Lorsqu'il s'agit de vérifier qu'une série de nombres est divisible par une même valeur, je comprends comment l'utiliser, mais dans ce cas là, sincèrement, c'est obscur. Dommage d'ailleurs, car mon but ce n'est pas d'avoir la solution, mais de comprendre.

Pour les accents, je n'en avais pas parlé car je n'avais simplement pas anticipé. Encore une fois, je débute.

Concernant les 11/2, 22/4 et 33/6, j'aurais dû mettre des guillemets pour que ce soit plus clair, car il faut simplement que le résultat rendu donne "11/2" dans la cellule, au lieu de "11".

Donc Patrice33740, à nouveau un grand merci pour ce code, mais j'espère que tu n'as pas interprété mes messages comme étant des critiques, car ce n'était absolument pas le cas.