Extraction caracteres numeriques

Bonsoir le forum
Toujours dans la continuité de mon précendet Post qui était de la recopie, J' ai une fonction d' extarction de tous les caracteres numériques d' une céllule qui fonctionne tres bien.

Code:

---

1 2 3 4 5 6 7 8

Function ExtraitCh$(ByVal Ch$) 'Ti Dim Bcle&, Car$ For Bcle = 1 To Len(Ch) Car = Mid$(Ch, Bcle, 1) ExtraitCh = ExtraitCh & IIf(InStr(1, Chiffres, Car) > 0, Car, " ") Next Bcle ExtraitCh = WorksheetFunction.Trim(ExtraitCh) End Function

---

Mais elle mérite d' etre affiné car si je l' emploie sur une cellule de ce type d' infos
Marvin Gaye - Live In Montreux 1980 CD1 - 05 - Come Get To This.mp3
Il me donne le résultat suivant : 1980 1 05 3
1980 1 et 3 je n' en veux pas
Je veux garder juste le numero des pistes = 05
Sachant que l' information au niveau des cellules ne comporte pas le meme nombre de caracteres, et ne sont disposé de la meme façon
Quelqu' un peut il me donner une idée
Si ce n' est pas assez clair n' hesitez pas à me le dire
Merci d' avance pour toute aide
Aladin

Bonjour,

Je vois deux approches possibles :

Un coup d'expressions régulières. Tu dois ajouter la référence à Scripting runtime, ou quelque chose de semblable et zigonner pour trouver le "pattern" qui permet de trouver deux nombres entre "- " et " -)" ou utiliser InstrRev(); ce qui donnerait quelque chose ressemblant à cela:

Code:

---

1 2 3 4 5

Sub cherchepiste() Dim numero As Variant numero = ExtraitCh2$("Marvin Gaye - Live In Montreux 1980 CD1 - 05 - Come Get To This.mp3") MsgBox (numero) End Sub

---

Code:

---

1 2 3 4 5

Function ExtraitCh2$(ByVal Ch$) 'Ti Dim position As integer position = InStrRev(Ch$, "-") ExtraitCh2$ = Mid(Ch$, position - 3, 2) End Function

---

InstrRev sert à trouver la position du dernier tiret. C'est l'équivalent de Instr() à la différence qu'elle commence par la fin du texte, au lieu du début. Ensuite, la fonction Mid recule de 3 espaces en partant de la position du dernier tiret et récupère 2 caractères. Tu peux toujours "endurcir" la fonction en vérifiant qu'elle récupère vraiment deux nombres et pas un nombre et un espace ou un espace et un nombre.

d'abord, ton titre est il toujours écrit de la même manière?

Citation:

---

"Marvin Gaye - Live In Montreux 1980 CD1 - 05 - Come Get To This.mp3"

---

avec des "-" de séparation?

Code:

---

1 2 3 4

numero =split("Marvin Gaye - Live In Montreux 1980 CD1 - 05 - Come Get To This.mp3","-") Auteur=numero (0) Album=numero (1) numero = numero (2)

---

Bonjour clement, rdurupt et le forum
Merci pour vos réponses rapide.
Les titres ne sont pas écrit de la meme facon, Clement est partie sur une bonne idée d' extraction des 2 caracteres numériques entre les " - -"
La procédure Sub cherchepiste() fonctionne mais j' aurais aimé que la fonction soit adapté en passant en parametre les céllules dans
exemple = ExtraitCh2$(E3)
Aladinn

Bonjour,

Pour la fonction, je vais devoir attendre quelques heures avant de regarder.

Hier soir, (la nuit dernière en Europe), j'ai pondu une sub qui balaie une plage de cellules, en fait, ce serait plutôt une colonne, et qui recherche, dans chaque cellule, deux chiffres bordés par des espaces. Hier, je me suis trompé au niveau de la référence à ajouter. Ce n'est pas Scripting Runtime qu'il faut ajouter, mais VBScript Regular Expressions 5.5 qu'il faut ajouter.

J'ai testé avec ton Marvin Gaye et cela a l'air de fonctionner à peu près. Dans une cellule formatée en texte, cela donne 05. Dans une cellule au format Nombre ou au format général, cela donne 5. Dans une msgbox, cela donne 05.

Si tu pouvais tester avec un nombre plus important de données; nous pourrions mieux voir si cela fonctionne convenablement. Au besoin, on pourrait sans doute en faire une fonction. Donc voilà l'œuvre:

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18

Sub cherchepiste2() Set re = New RegExp re.Pattern = "\s{1}[0-9]{2}\s{1}" re.Global = True Dim texte As String Dim cellule As Range Dim unmatch As Match Dim matchs As MatchCollection For Each cellule In ActiveSheet.UsedRange texte = "" Set matchs = re.Execute(cellule.Text) For Each unmatch In matchs texte = texte & unmatch.Value cellule.Offset(rowOffset:=0, columnOffset:=1).Value = texte MsgBox (texte) Next Next End Sub

---

Bonjour,

Citation:

---

Envoyé par Aladin_23

La procédure Sub cherchepiste() fonctionne mais j' aurais aimé que la fonction soit adapté en passant en parametre les céllules dans
exemple = ExtraitCh2$(E3)
Aladinn

---

Voici donc Eztraitch3(). Cela marche avec une seule cellule comme "Range", mais je ne sais pas ce que cela peut donner avec 2 cellules ou plus. Cette fois-ci je l'ai testée seulement comme fonction de feuille de calcul.

Code:

---

1 2 3 4 5

Function ExtraitCh3(plage As Range) Dim position As Integer position = InStrRev(plage.Text, "-") ExtraitCh2$ = Mid(Ch$, position - 3, 2) End Function

---

Bonjour clement et le forum
Merci à toi clement pour toutes ces solutions, j' ai décidé de garder la fonction
ExtraitCh3.
J' ai un autre souci pour copier le contenu d' une cellule

Entre le chiffre 7 de la colonne A, il existe dans une cellule de la colonne B une cellule rempli avec un nom de fichier en .jpg ou .gif
Me prendre le nom du fichier jpg ou gif et le placer dans la colonne C dans la cellule correspondant au 7 Superieur.

J' ai mis une piece jointe qui sera peut etre plus parlante

merci d' avance pour l' aide

Aladin

Ceci marche mais j'ai utilisé la fonction Right pour tester les 3 derniers caractères et ainsi voir si l'extension est un "jpg" ou un "gif".

Attention parce que dans ton exemple le fichier "toto.jpg" était écrit "toto.jpg " avec un espace à la fin donc la macro marchait plus.

Tu peux utiliser la fonction InStr à la place qui recherche des caractères particuliers dans une variable string pour éviter le problème mais si tu as une chanson avec "gif" dedans, ça risque de mettre celle-là.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26

Sub Test()   Dim i, j As Integer   ' Tant que la colonne B n'est pas vide While ThisWorkbook.Worksheets("Contenu de répertoire").Range("B2").Offset(i, 0) <> ""   ' Si la colonne A contient 7 If ThisWorkbook.Worksheets("Contenu de répertoire").Range("A2").Offset(i, 0) = 7 Then   ' Tant que les 3 derniers caractères de la cellule de la colonne B sont différents de "jpg" ou "gif" j = i While Right(ThisWorkbook.Worksheets("Contenu de répertoire").Range("B2").Offset(j, 0), 3) <> "jpg" And Right(ThisWorkbook.Worksheets("Contenu de répertoire").Range("B2").Offset(j, 0), 3) <> "gif" j = j + 1 Wend   ThisWorkbook.Worksheets("Contenu de répertoire").Range("C2").Offset(i, 0) = ThisWorkbook.Worksheets("Contenu de répertoire").Range("B2").Offset(j, 0)   End If   i = i + 1 Wend       End Sub

---