VBA et numérologie v2
Résolu
Bonjour,
Je rebondis sur mon précédent sujet :
https://forums.commentcamarche.net/forum/affich-37078820-vba-et-numerologie
Voici donc la fonction actuelle :
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 !
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
-
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 -
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 ?
-
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. -
C'est bien cela, merci beaucoup !
Je tente de trouver la suite par moi-même, en espérant que ça marche :) -
Je reviens plus tôt que prévu...
J'aimerais additionner les valeurs de deux résultats deNumVoyelles
(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... :(-
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
-
-
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 ! :) -
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.
