VBA et numérologie v2

Résolu
Roi_Burgonde Messages postés 24 Date d'inscription   Statut Membre Dernière intervention   -  
Roi_Burgonde Messages postés 24 Date d'inscription   Statut Membre Dernière intervention   -
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 !
A voir également:

7 réponses

Réponse 1 / 7
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
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
2
Réponse 2 / 7
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
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 ?

1
Réponse 3 / 7
Roi_Burgonde Messages postés 24 Date d'inscription   Statut Membre Dernière intervention  
 
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.
0
Réponse 4 / 7
Roi_Burgonde Messages postés 24 Date d'inscription   Statut Membre Dernière intervention  
 
C'est bien cela, merci beaucoup !
Je tente de trouver la suite par moi-même, en espérant que ça marche :)
0

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

Posez votre question
Réponse 5 / 7
Roi_Burgonde Messages postés 24 Date d'inscription   Statut Membre Dernière intervention  
 
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... :(
0
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
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
0
Réponse 6 / 7
Roi_Burgonde Messages postés 24 Date d'inscription   Statut Membre Dernière intervention  
 
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 ! :)
0
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
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.
0
Réponse 7 / 7
Roi_Burgonde Messages postés 24 Date d'inscription   Statut Membre Dernière intervention  
 
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.
0

Discussions similaires

Streaming : Les arnaques à connaître !
greazon -
Lovelyz07 -

17 réponses
Site fiable pour film en streaming ?
Utilisateur anonyme -
Utilisateur anonyme -

7 réponses
"L'indice n'appartient à la sélection" + VBA
fleur.31 -
geosevda -

2 réponses
Erreur d'exécution 13 Incompatibilité de type
grace -
pijaku -

5 réponses
Virus site de streaming?
kichou114 -
Pascattack -

5 réponses