XL 2016 Scinder cellule alphanumérique en plusieurs colonnes chiffres ou lettres

[Vero2782]

Bonjour,
J'ai une liste de cellule contenant le nom, numéro civique, ville, et un no de client. Malheureusement, il n'y a ni virgule, ni espaces pour séparer les informations...
ex. : TREMBLAY0258MONTREAL357896541258A.jpg

J'aimerais retirer les chiffres de la fin et le .jpg et obtenir TREMBLAY0258MONTREAL

J'ai réussit à retirer le "A.jpg" avec la formule matricielle suivante :
=LEFT(B1,MAX((MID(B1,ROW(INDIRECT("1:" & LEN(B1))),1)>="0")*(MID(B1,ROW(INDIRECT("1:" & LEN(B1))),1)<="9")*ROW(INDIRECT("1:" & LEN(B1)))))


Maintenant, je vois deux solutions :
1- La première, une macro qui séparerait l'information à chaque fois qu'on passe d'une lettre à un chiffre ou d'un chiffre à une lettre . J'aurais ainsi plusieurs colonne et il me resterait qu'à "Concacener" celles que j'ai besoin.

2- La deuxième, une macro qui compterait le nombre de chiffre à la fin de la cellule pour que je puisse ensuite la "trimmer" selon le nombre de digit.

J'ai trouvé cette macro sur ce forum mais elle compte aussi les chiffres du centre

Public Function CompteNumericDigit(ByRef Cell As Range)
Dim Expression As String, ExpressionC As String
Dim TotCar As Byte
Dim Compteur As Byte
Dim Car As String
Application.Volatile

Expression = Cell.Value
TotCar = Len(Expression)
For Compteur = 1 To TotCar
Car = Right(Left(Expression, Compteur), 1)
If IsNumeric(Car) = True Then
ExpressionC = ExpressionC & Car
End If
Next
CompteNumericDigit = Len(ExpressionC)
End Function

Pouvez-vous m'aider ?

Merci

 

[Victor21]

Bonsoir.

Avez-vous tenté de remettre le compteur à zéro si if isnumeric(car) n'est pas true

 

[Vero2782]

Bonjour Victor,

En ajoutant
If IsNumeric(Car) = True Then
ExpressionC = ExpressionC & Car
Else
IsNumeric(Car) = 0
End If
Next

J'ai une compile error : "Function call on left-hand side of assignment must return Variant or Object"

Peut-être que je ne met pas la remise à 0 au bon endroit ?

 

[Victor21]

Re,

Pas vbaiste pour un sou, mais peut-être :
If IsNumeric(Car) = True Then
ExpressionC = ExpressionC & Car
Else
ExpressionC =""
End If
Next
Dommage que vous n'ayez pas jugé utile de joindre un court fichier exemple, qui aurait permis à ceux que le problème intéresse de tester leurs propositions in situ avant de vous les soumettre. Mais c'est votre choix...

 

[Staple1600]

Bonsoir le fil, le forum, vero2782, Victor21

Si j'étais moi, je tenterai la piste regexp
Il suffit de trouver le bon pattern (mais là de suite je vais plutôt devoir trouver mon lit)
Je te laisse investiguer sur cette base (voir exemples ci-dessous)

Function ExtraireChiffres(Chaine As String) As String
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "[^\d]+"
ExtraireChiffres = .Replace(Chaine, vbNullString)
End With
End Function
Sub test1()
Dim s_Str$
s_Str = "abcef12345ghij678.jpg"
MsgBox ExtraireChiffres(s_Str)
End Sub
Sub test2()
Dim s_Str$, regexMatches As Object

s_Str$ = "TOTO123titi1234567.jpg"
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "(\d{7})+"
    Set regexMatches = .Execute(s_Str$)
End With

MsgBox regexMatches(0)
End Sub

 

[Staple1600]

Bonsoir le fil, le forum

On avance, on avance, on avance... comme dirait Alain S.

Sub test3()
Dim s_Str$, regexMatches As Object, i As Byte
s_Str$ = "TREMBLAY0258MONTREAL357896541258A.jpg"
With CreateObject("vbscript.regexp")
    .MultiLine = False: .Global = True: .Pattern = "[0-9]{1,100}"
    Set regexMatches = .Execute(s_Str$)
End With
For i = 0 To 1
MsgBox regexMatches(i)
Next
End Sub
Sub test4()
Dim s_Str$, regexMatches As Object, i As Byte
s_Str$ = "TREMBLAY0258MONTREAL357896541258A.jpg"
With CreateObject("vbscript.regexp")
    .MultiLine = False: .Global = True: .Pattern = "[a-zA-Z]{1,100}"
    Set regexMatches = .Execute(s_Str$)
End With
For i = 0 To 2
MsgBox regexMatches(i)
Next
End Sub

 

[mapomme]

Bonsoir Vero2782,Victo21 , Staple1600 ,

voir correction message ICI

 

[Staple1600]

Bonne nuit le fil, le forum

@mapomme
Jolies, tes fonctions VBA pur beurre
Point tenté par les expressions régulières ?
Histoire de m'aider à moins tâtonner avec mon pattern ?

 

[mapomme]

Re,

Maintenant, je vois deux solutions :
1- La première, une macro qui séparerait l'information à chaque fois qu'on passe d'une lettre à un chiffre ou d'un chiffre à une lettre . J'aurais ainsi plusieurs colonne et il me resterait qu'à "Concacener" celles que j'ai besoin.

2- La deuxième, une macro qui compterait le nombre de chiffre à la fin de la cellule pour que je puisse ensuite la "trimmer" selon le nombre de digit.

Oubliez mon dernier essai. Préférez celui là !

Deux fonctions personnalisées :

1. Groupe(x, n As Long) qui renvoie le n ème groupe de lettres ou de chiffres de x
2. FinTexte(x) qui renvoie le rang du dernier caractère utile de x

Pour les deux fonctions, on ne prend en compte que la partie des caractères avant le premier point.

 

[mapomme]

Bonjour Staple1600 ,

@mapomme
Point tenté par les expressions régulières ?
Histoire de m'aider à moins tâtonner avec mon pattern ?

Je fais un blocage inexpliqué sur les expressions régulières. J'ai déjà essayé maintes fois de m'y mettre avec de nombreux tuto très bien faits. A chaque fois c'est un lamentable échec qui me démoralise jusqu"au lendemain. Il doit y avoir un câble débranché au niveau de mon petit cerveau de poulet .

 

[Staple1600]

Bon petit matin le fil, le forum

@mapomme
C'est explicitement sans option que tu ponds du code VBA

Tu fais assurément dans la qualité 0, mon coco

Avec ton ciboulot de poulet et ma tête de linotte, on devrait pourtant casser au moins trois pattes à un canard dans cette histoire

 

[mapomme]

Bonjour à tous,

Tu fais assurément dans la qualité 0, mon coco

J'aime bien le BIO !

Avec ton ciboulot de poulet et ma tête de linotte, on devrait pourtant casser au moins trois pattes à un canard dans cette histoire

Le canard est toujours vivant ! Essayons de l’occire.

Malgré le fait que je suis une bille en expressions régulières, j'ai construit une fonction personnalisée à partir de tes deux derniers pattern : GroupeNum(xs As String, xn As Long) qui renvoie le n ème groupe de lettres ou de chiffres de xs (on élimine le premier point et tous les caractères au-delà).

Voir fichier joint.

 

[Staple1600]

Re,

Aprés la cibiche et le café qui vont bien, et pendant que tu cogitais
Après quelques recherhces sur le web
je suis arrivé à ce bout de code un chouia trop radical

Private pRegEx As Object

Public Property Get oRegEx() As Object
   If (pRegEx Is Nothing) Then Set pRegEx = CreateObject("Vbscript.Regexp")
   Set oRegEx = pRegEx
End Property

Public Function RegExReplace(ByVal SourceText As String, _
      ByVal SearchPattern As String, _
      ByVal ReplaceText As String, _
      Optional ByVal bIgnoreCase As Boolean = True, _
      Optional ByVal bGlobal As Boolean = True, _
      Optional ByVal bMultiLine As Boolean = True) As String
  
   With oRegEx
      .Pattern = SearchPattern: .IgnoreCase = bIgnoreCase
      .Global = bGlobal: .MultiLine = bMultiLine
      RegExReplace = .Replace(SourceText, ReplaceText)
   End With
End Function 'merci à ebs17 pour cette fonction

Sub test6()
Dim sTrr$: sTrr = "TREMBLAY0258MONTREAL357896541258A.jpg"
MsgBox Split(RegExReplace(sTrr, "[0-9]{1,100}", vbNullString, True, True, False), ".")(0)
End Sub

Bon m'en vais de suite dans ton poulailler , voir ta dernière ponte

 

[Staple1600]

Re

@mapomme
On est bon là, on tient le pattern par le bon bout, camarade
On part sur la course à celui qui la moins longue procédure ?
Hsitoire d'aider nos neurones à se réveiller, mon petit gallus malum ?

 

[mapomme]

Re,

On part sur la course à celui qui a la moins longue procédure ?
Histoire d'aider nos neurones à se réveiller, mon petit gallus malum ?

Bien au contraire, avant de voir comment je peux me la raccourcir, je vais prendre un thé avec la sucette à cancer qui va bien et faire un p'ti somme...