VBA et numérologie v2 [Résolu]

Signaler
Messages postés
24
Date d'inscription
mercredi 15 avril 2020
Statut
Membre
Dernière intervention
18 février 2021
-
Messages postés
24
Date d'inscription
mercredi 15 avril 2020
Statut
Membre
Dernière intervention
18 février 2021
-
Bonjour,

Je rebondis sur mon précédent sujet :
https://forums.commentcamarche.net/forum/affich-37078820-vba-et-numerologie

Voici donc la fonction actuelle :

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


Si je refais un sujet, c'est parce que je n'ai pas réussi à extraire les valeurs des voyelles ou des consonnes seulement.
Je pensais pouvoir isoler les valeurs de la chaîne de caractères (nom ou prénom) dans une variable, mais la seule fois ou j'ai réussi à obtenir un semblant de résultat, ça ne collait pas du tout (en ayant extrait les voyelles mais en gardant la fonction MOD, les valeurs des lettres n'étaient plus les bonnes).

Quelqu'un aurait-il une idée sur la manière d'extraire la valeur des voyelles ou des consonnes sachant que cela doit être dans une autre cellule ?

D'avance merci !

7 réponses

Messages postés
8439
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
26 février 2021
1 612
Bonjour,

Il suffit d'utiliser une autre fonction similaire à celle-ci.
Il faudrait savoir quelle est la valeur de chaque voyelle, quelle est la valeur de chaque consonne, est-ce la même que dans la fonction ci-dessus ?

Y-a-t'il comme ci-dessus, des cas particuliers ?

Cordialement
Patrice

Personne ne peut détenir tout le savoir, c'est pour ça qu'on le partage.
Messages postés
8439
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
26 février 2021
1 612
Bonjour,

Voilà avec 2 fonctions supplémentaires, NumVoyelles et NumConsonnes :
Option Explicit
Function NumVoyelles(ByVal s As String) As Variant
Dim i As Integer
Dim n As Integer
Const a$ = "AEIOUY"
  s = UCase(supprAccents(s))
  For i = 1 To Len(s)
    If InStr(1, a, Mid(s, i, 1)) > 0 Then
      n = n + 1 + (Asc(Mid(s, i, 1)) - 65) Mod 9
    End If
  Next i
  Select Case n
    Case 11
      NumVoyelles = "11/2"
    Case 22
      NumVoyelles = "22/4"
    Case 33
      NumVoyelles = "33/6"
    Case Else
      NumVoyelles = 1 + (n - 1) Mod 9
  End Select
End Function
Function NumConsonnes(ByVal s As String) As Variant
Dim i As Integer
Dim n As Integer
Const a$ = "BCDFGHJKLMNPQRSTVWXZ"
  s = UCase(supprAccents(s))
  For i = 1 To Len(s)
    If InStr(1, a, Mid(s, i, 1)) > 0 Then
      n = n + 1 + (Asc(Mid(s, i, 1)) - 65) Mod 9
    End If
  Next i
  Select Case n
    Case 11
      NumConsonnes = "11/2"
    Case 22
      NumConsonnes = "22/4"
    Case 33
      NumConsonnes = "33/6"
    Case Else
      NumConsonnes = 1 + (n - 1) Mod 9
  End Select
End Function
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
Messages postés
24
Date d'inscription
mercredi 15 avril 2020
Statut
Membre
Dernière intervention
18 février 2021

Bonjour Patrice,

Exactement, les valeurs des voyelles et des consonnes doivent rester les mêmes.
Il y a effectivement les mêmes cas (11/2, 22/4 et 33/6), pas d'autres particularités en revanche.
Messages postés
24
Date d'inscription
mercredi 15 avril 2020
Statut
Membre
Dernière intervention
18 février 2021

C'est bien cela, merci beaucoup !
Je tente de trouver la suite par moi-même, en espérant que ça marche :)
Messages postés
24
Date d'inscription
mercredi 15 avril 2020
Statut
Membre
Dernière intervention
18 février 2021

Je reviens plus tôt que prévu...

J'aimerais additionner les valeurs de deux résultats de
NumVoyelles
(F2 et F4) en une troisième (F6).
J'ai tenté par formule :
MOD(
1+(SOMME(
SI($F$2="11/2";2;SI($F$2="22/4";4;SI($F$2="33/6";6;$F$2)));
SI($F$4="11/2";2;SI($F$4="22/4";4;SI($F$4="33/6";6;$F$4)));
)-1);
9)


Si je retire la fonction MOD de la formule, tout va bien, mais j'aimerais de nouveau obtenir un chiffre unique

Et en VBA :

Function NumIntime(n1 As Variant, n2 As Variant) As Variant

Dim i As Integer

Select Case n1
Case "11/2"
n1 = 2
Case "22/4"
n1 = 4
Case "33/6"
n1 = 6
Case Else
n1 = n1
End Select
Select Case n2
Case "11/2"
n2 = 2
Case "22/4"
n2 = 4
Case "33/6"
n2 = 6
Case Else
n2 = n2
End Select

i = WorksheetFunction.Sum(n1 + n2)
End Function


Vu que je débute en VBA, je dois être bien à côté de la plaque, mais pour la formule ça m'embête.

J'aurais aimé pouvoir faire cela tout seul, mais visiblement je patauge encore trop... :(
Messages postés
8439
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
26 février 2021
1 612
C'etait presque ça :
Function NumIntime(n1 As Variant, n2 As Variant) As Variant
Dim n As Long
 Select Case n1
    Case "11/2"
        n = 2
    Case "22/4"
        n = 4
    Case "33/6"
        n = 6
    Case Else
        n = n1
  End Select
  Select Case n2
    Case "11/2"
        n = n + 2
    Case "22/4"
        n = n + 4
    Case "33/6"
        n = n + 6
    Case Else
        n = n + n2
  End Select
  NumIntime = n
End Function
Messages postés
24
Date d'inscription
mercredi 15 avril 2020
Statut
Membre
Dernière intervention
18 février 2021

Aaaah je n'avais pas pensé à faire évoluer la variable n, je pensais qu'il fallait compiler seulement à la fin ! Un grand merci :D

Pour me compliquer la vie, j'ai même rajouté un petit bloc pour réitérer les "11/2", "22/4" et "33/6" :

Select Case n
Case 11
NumIntime = "11/2"
Case 22
NumIntime = "22/4"
Case 33
NumIntime = "33/6"
Case Else
NumIntime = 1 + (n - 1) Mod 9
End Select


Et ça m'a tout l'air de marcher ! J'en comprends un peu plus à chaque fois, donc un très grand merci ! :)
Messages postés
8439
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
26 février 2021
1 612
Ici Case 22 et Case 33 sont inutiles,
le maximum de n1 et de n2 est 9, 9+9=18 : pas de 22 ni de 33.
Messages postés
24
Date d'inscription
mercredi 15 avril 2020
Statut
Membre
Dernière intervention
18 février 2021

Ah... Comme quoi la logique ne vient pas en deux minutes.
Je n'avais pas pensé à ça, donc ça me pose un petit problème lorsque je veux le faire avec deux variables (nom et prénom) sans les réduire au préalable.
Pour simplifier, j'ai fait une nouvelle fonction pour calculer la valeur des consonnes de deux variables et de réduire à la fin, mais ça ne fonctionne pas lorsque je tombe sur l'un des cas particuliers (11, 22 ou 33) :


Function NumConsBrut(ByVal s1 As String, ByVal s2 As String) As Variant
Dim i As Integer
Dim n As Integer
Dim s As String
s = s1 & s2
Const a$ = "BCDFGHJKLMNPQRSTVWXZ"
s = UCase(supprAccents(s))
For i = 1 To Len(s)
If InStr(1, a, Mid(s, i, 1)) > 0 Then
n = n + 1 + (Asc(Mid(s, i, 1)) - 65) Mod 9
End If
Next i
Select Case n
Case 11
NumConsBrut = "11/2"
Case 22
NumConsBrut = "22/4"
Case 33
NumConsBrut = "33/6"
Case Else
NumConsBrut = 1 + (n - 1) Mod 9
End Select
End Function


J'ai essayé avec un case 11, 22, 33 supplémentaire, juste après, mais pas de résultat non plus.