Séparer chiffres et lettres et en supprimer certains
GAEL8311
-
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention -
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention -
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???
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
-
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
-
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+
