[VBA] identifier les caractères à l'intérieur d'une cellule

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

F22Raptor

XLDnaute Impliqué
Hola compañeros,
j'ai affecté une valeur numérique à chaque lettre de l'alphabet (disons de 0.1 à 2.6 pour faire simple, et 0.1 pour un espace).

Pour un mot placé dans une cellule (qui peut contenir de 2 à 20 caractères, avec éventuellement des espaces), j'aimerais calculer sa "valeur numérique".

Idéalement, il me faudrait un truc du genre :
For Each Character in Range("A1").Characters

et ensuite je vais chercher dans ma base la valeur numérique du caractère, et je l'ajouter à ma variable

MAIS : évidemment, ça ne marche pas !

Une idée ?
 
Re : [VBA] identifier les caractères à l'intérieur d'une cellule

Je ne vais pas vous embêter à ce point ! 😛

Disons que pour le faire, j'y arrive (cf. ci-dessous), mais le moyen utilisé ne me paraît pas efficient.
Idéalement, le For Each Character ou un équivalent serait adéquat.


Code:
Dim i As Byte
Dim ValNum As Double

For i = 1 To Len(Range("H2").Value)

    ValNum = ValNum + Cells(Application.Match(Range("H2").Characters(i, 1).Text, Columns(1)), 2).Value

Next i

MsgBox ValNum

Avec en colonne A : la liste de mes caracères : 0, 1, 2...., 9, a, b, ..., z
En colonne B : les valeurs associées
 
Re : [VBA] identifier les caractères à l'intérieur d'une cellule

Bonjour, cette fonction revoie la valeur du texte de la cellule
je n'ai traité que les minuscules, a compléter
Cordialement


Public Function ValeurTexte(texte As String) As Double
ValeurTexte = 0

For i = 1 To Len(texte)
Select Case Mid(texte, i, 1)
Case " ": ValeurTexte = ValeurTexte + 0.1
Case "a": ValeurTexte = ValeurTexte + 0.2
Case "b": ValeurTexte = ValeurTexte + 0.3
Case "c": ValeurTexte = ValeurTexte + 0.4
Case "d": ValeurTexte = ValeurTexte + 0.5
Case "e": ValeurTexte = ValeurTexte + 0.6
Case "f": ValeurTexte = ValeurTexte + 0.7
Case "g": ValeurTexte = ValeurTexte + 0.8
Case "h": ValeurTexte = ValeurTexte + 0.9
Case "i": ValeurTexte = ValeurTexte + 1
Case "j": ValeurTexte = ValeurTexte + 1.1
Case "k": ValeurTexte = ValeurTexte + 1.2
Case "l": ValeurTexte = ValeurTexte + 1.3
Case "m": ValeurTexte = ValeurTexte + 1.4
Case "n": ValeurTexte = ValeurTexte + 1.5
Case "o": ValeurTexte = ValeurTexte + 1.6
Case "p": ValeurTexte = ValeurTexte + 1.7
Case "q": ValeurTexte = ValeurTexte + 1.8
Case "r": ValeurTexte = ValeurTexte + 1.9
Case "s": ValeurTexte = ValeurTexte + 2
Case "t": ValeurTexte = ValeurTexte + 2.1
Case "u": ValeurTexte = ValeurTexte + 2.2
Case "v": ValeurTexte = ValeurTexte + 2.3
Case "w": ValeurTexte = ValeurTexte + 2.4
Case "x": ValeurTexte = ValeurTexte + 2.5
Case "y": ValeurTexte = ValeurTexte + 2.6
Case "z": ValeurTexte = ValeurTexte + 2.7
End Select
Next

End Function
 
Re : [VBA] identifier les caractères à l'intérieur d'une cellule

Bonjour F22Raptor, Papou, R@chid, PhilouF,

Voyez cette fonction personnalisée (à placer dans un module standard) :

Code:
Function Poids#(t$)
Dim a$, b$, i%, code As Byte
t = UCase(t) 'majuscules
'---supression des accents---
a = "ÀÁÂÃÄÅÒÓÔÕÖØÈÉÊËÌÍÎÏÙÚÛÜŸÑÇ"
b = "AAAAAAOOOOOOEEEEIIIIUUUUYNC"
For i = 1 To Len(a)
  t = Replace(t, Mid(a, i, 1), Mid(b, i, 1))
Next
'---pesage---
For i = 1 To Len(t)
  code = Asc(Mid(t, i, 1))
  If code > 64 And code < 91 Then Poids = Poids + (code - 64) / 10
  If code = 32 Then Poids = Poids + 0.1
Next
End Function
A+
 
Re : [VBA] identifier les caractères à l'intérieur d'une cellule

Merci à tous pour vos réponses ! 🙂

Rachid : ça m'a l'air la plus directe / simple / rapide
Je sens que je vais regarder de ce côté !

Je me remets la tête dans le guidon

Ciao les gars, et bonnes fêtes
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Retour