VBA et numérologie v2 Résolu/Fermé

Question

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 ExplicitFunction Numerologie(ByVal s As String) As VariantDim i As IntegerDim 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 SelectEnd FunctionFunction supprAccents(txt As String) As StringDim s As StringDim i As LongConst 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 = sEnd 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 !

Patrice33740 · Accepted Answer

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

Patrice33740 · Answer

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 ?

Roi_Burgonde · Answer

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.

Roi_Burgonde · Answer

C'est bien cela, merci beaucoup !
Je tente de trouver la suite par moi-même, en espérant que ça marche :)

Roi_Burgonde · Answer

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 VariantDim 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 Selecti = 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... :(

Roi_Burgonde · Answer

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 ! :)

Roi_Burgonde · Answer

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 VariantDim i As IntegerDim n As IntegerDim s As String  s = s1 & s2Const 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 SelectEnd Function

J'ai essayé avec un case 11, 22, 33 supplémentaire, juste après, mais pas de résultat non plus.

VBA et numérologie v2

7 réponses

Discussions similaires

Newsletters