Séparer chiffres et lettres et en supprimer certains

[Fermé]
Signaler
-
Messages postés
16523
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
28 septembre 2021
-
Bonjour,

Je suis débutant en programmation vbs et j'aimerais supprimer des chiffres tout en gardant les 2 derniers, je m'explique voici mon exemple :

185311437TOURS
69 TAPONAS
Sur le premier j'aimerais supprimer 1853114 et ne garder que 37TOURS

J'ai déjà fait ca Ch10=left(mTab(9),2)&";"& Mid(mtab(9),4,20) pour séparer 69 et TAPENAS sauf bien sur que je me retrouve aussi avec un 18 et 5311437TOURS (je voudrais juste un 37 et TOURS).

Pouvez vous me guider???

2 réponses

Messages postés
16523
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
28 septembre 2021
3 229
Bonjour

Pour le fun, un exemple en utilisant la bibliothèque de mon grenier
(textes en colonne A restitution en colonne B

Option Explicit
'------- --------
Sub separer_nombre_texte()
Dim texto As String, Lig As Integer, Derlig As Integer

Application.ScreenUpdating=false
With ActiveSheet
Derlig = .Columns("A").Find(what:="*", searchdirection:=xlPrevious).Row
For Lig = 1 To Derlig
texto = .Cells(Lig, "A")
.Cells(Lig, "B") = Right(extrait_chiffres(texto), 2) & " " & extrait_lettres(texto)
Next
End With
End Sub
'--------------
Function extrait_chiffres(ByRef texto As String) As Long
Dim reg As Object
Dim extraction As Object
Dim Digit

Set reg = CreateObject("vbscript.regexp")
'on travaille sur toute la cellule
reg.Global = True
'le modèle est des caractères "digitaux ("d") à n chiffres (d?\)
reg.Pattern = "(\d)"
' éxécute l'extraction svt modèle (collection des digits...)
Set extraction = reg.Execute(texto)
For Each Digit In extraction
' concaténète les membres de la collection "extraction"
extrait_chiffres = extrait_chiffres & (Digit.Value)
Next Digit
Set extraction = Nothing
Set reg = Nothing
End Function
'-------
Function extrait_lettres(ByRef texto As String) As String
Dim reg As Object
Dim extraction As Object
Dim Digit
Set reg = CreateObject("vbscript.regexp")
reg.Global = True
reg.Pattern = "(\D)"
Set extraction = reg.Execute(texto)
For Each Digit In extraction
extrait_lettres = extrait_lettres & (Digit.Value)
Next Digit
Set extraction = Nothing
Set reg = Nothing
End Function

1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 41713 internautes nous ont dit merci ce mois-ci

Messages postés
1953
Date d'inscription
lundi 3 mai 2010
Statut
Membre
Dernière intervention
12 août 2021
151
Bonjour,

Repère la position de la première lettre dans ta chaîne de caractères complète avec une boucle, puis utilise Mid ou Right pour prendre la chaîne à partir de cette position moins 2 crans...

Pour trouver la position tu peux p. ex. utiliser Do While ... Loop :
- avec les codes ASCII (Asc(caractère) renvoie le code ASCII)
- et InStr(caractère,"0123456789")>0

A+