VBA et numérologie

Résolu/Fermé

Roi_Burgonde Messages postés 24 Date d'inscription mercredi 15 avril 2020 Statut Membre Dernière intervention 18 février 2021 - 5 févr. 2021 à 12:20
Roi_Burgonde Messages postés 24 Date d'inscription mercredi 15 avril 2020 Statut Membre Dernière intervention 18 février 2021 - 6 févr. 2021 à 01:32

Bonjour à tous,

Je suis débutant en VBA et je n'arrive pas du tout à obtenir le résultat souhaité pour plusieurs éléments.

En A1 (Prénom), je cherche à remplacer des lettres par des valeurs comprises entre 1 et 9, puis les additionner entre elles jusqu'à n'obtenir qu'un chiffre compris entre 1 et 9, en ayant le résultat en B1.

Ex : Michel = 493853 = 32 = 5

J'ai essayé différentes tambouilles, avec Loopn Replace, Mid et Code mais c'est malheureusement encore trop compliqué pour moi... :/

Pour compliquer les choses, il y a deux éléments à prendre en compte :
- Les lettres ont des valeurs (A,J,S = 1, B,K,T=2, C,L,U=3, D,M,V=4 etc.)
- Si jamais la somme atteint certaines valeurs (11, 22 ou 33), il faut remplacer par d'autres caractères.

D'avance merci à ceux qui ont une idée de comment faire !

A vous lire

A voir également:

VBA et numérologie
Incompatibilité de type vba ✓ - Forum Programmation
Vba attendre 1 seconde ✓ - Forum VB / VBA
Vba dernière colonne non vide ✓ - Forum VB / VBA
Vba récupérer valeur cellule ✓ - Forum VB / VBA
Mkdir vba ✓ - Forum VB / VBA

8 réponses

Réponse 1 / 8

Le Pingou Messages postés 12035 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 1 avril 2024 1 425
5 févr. 2021 à 13:17

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

Réponse 2 / 8

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
Modifié le 5 févr. 2021 à 13:37

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

Réponse 3 / 8

eriiic Messages postés 24569 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 28 décembre 2023 7 212
5 févr. 2021 à 14:10

Bonjour à tous,

une version par formule :

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

eric

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
Modifié le 5 févr. 2021 à 14:55

Attention, i = 9

La formule serait plutôt :

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

L'éternel piège des MOD qui sont similaires à Option Base 0.

Réponse 4 / 8

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
Modifié le 5 févr. 2021 à 14:58

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

eriiic Messages postés 24569 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 28 décembre 2023 7 212
5 févr. 2021 à 19:20

Ah ben ma réponse est passée à la trappe, j'ai dû oublier de valider.

Oui, j'ai patiné et il restait des coquilles, merci :-)
Je croyais y être arrivé avec un seul Mod(), mais non...

Tu as bien fait de reprendre ta fonction.
Je m'étais servi de la précédente pour contrôler et elle m'avait retourné 10 pour "abcdefg"
On va dire 1 partout alors ;-)

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 8

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
Modifié le 5 févr. 2021 à 23:49

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

Roi_Burgonde Messages postés 24 Date d'inscription mercredi 15 avril 2020 Statut Membre Dernière intervention 18 février 2021
6 févr. 2021 à 01:32

Que dire, à part à nouveau merci, pour la solution et encore plus pour l'explication !

Il me reste du pain sur la planche pour mieux comprendre Mid et quelques autres détails mais c'est plus clair.

Je me suis même permis de rajouter :

 s = Replace(s , " ", vbNullString)

en ligne 6 pour supprimer les espaces.
Encore merci !

Réponse 6 / 8

Roi_Burgonde Messages postés 24 Date d'inscription mercredi 15 avril 2020 Statut Membre Dernière intervention 18 février 2021
Modifié le 5 févr. 2021 à 22:40

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 !

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
Modifié le 5 févr. 2021 à 22:58

Pour le remplacement des lettres par leur valeur c'était simple de comprendre que c'est un modulo 9.

On n'a pas traité le cas 11, 22, 33 parce que tu n'avais pas donné de détail !!!

Maintenant tu dis « remplacer par 11/2, 22/4 ou 33/6 »
C'est pas très clair, est-ce à dire 5,5 ???

Code :

Option Explicit
Function Numerologie(ByVal s As String) As Double
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
  Select Case n
    Case 11, 22, 33
      Numerologie = 5.5
    Case Else
      Numerologie = 1 + (n - 1) Mod 9
  End Select
End Function

Pour les accents c'est un autre problème dont tu n'avais pas parlé.

Réponse 7 / 8

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
5 févr. 2021 à 23:15

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.

Réponse 8 / 8

Roi_Burgonde Messages postés 24 Date d'inscription mercredi 15 avril 2020 Statut Membre Dernière intervention 18 février 2021
5 févr. 2021 à 23:21

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.

Discussions similaires

"L'indice n'appartient à la sélection" + VBA

VBA : Range avec références variables..

VBA erreur 1004

ouverture d'un fichier excel à partir d'un code VBA

Méthode find dans VBA - Recherche de données sous Excel

Discussions similaires

Newsletters