Extraction d'une sous chaine de caractere VBA

Fermé
malco - Modifié par malco le 26/09/2011 à 09:58
 malco - 26 sept. 2011 à 11:26
Bonjour,

j'ai comme exercice d'extraire des sous-chaines de caractères qui se situent exactement après la même sous-chaine fixe.
Voici un exemple : Dans la chaine suivante :

##RES##paul##Copozef##RES##coco##pppezriuezrkjpp##RES##papa##

je dois extraire exactement les sous chaines suivante : paul, coco, papa
Ces 3 termes se situent exactement après la meme constante : ##RES##
J'ai fait le code suivant :

Sub ExtractDatas()

Dim lettre As String

Data = ""
d = 0

ThisWorkbook.Worksheets("datas").Range("B1:B100").Select
Selection.Clear


GoRef1 = InStr(1, ThisWorkbook.Worksheets("datas").Range("A1").Value, "##RES#")

'1er check : commence du begin de la chaine

For i = GoRef1 To Len(ThisWorkbook.Worksheets("datas").Range("A1")) Step 7 + Len(Data)

Data = ""

If Mid(ThisWorkbook.Worksheets("datas").Range("A1"), i, 1) <> "#" Then

Do While Mid(ThisWorkbook.Worksheets("datas").Range("A1"), i, 1) <> "#"
Data = Data & Mid(ThisWorkbook.Worksheets("datas").Range("A1"), i, 1)
i = i + 1
Loop

End If

d = d + 1

ThisWorkbook.Worksheets("datas").Range("b" & d).Value = Data

Next i

End Sub

Le probleme est que ce code ne fonctionne pas correctement car il n'extrait pas que les 3 mots qui se trouvent après la sous-chaine constante, mais d'autres sous-chaines fausses (voici l'output : paul, ef, coco, riuezrkjpp, papa).

Pouvez vous me guider svp pour que le code n'affiche plus que les bons termes?

Merci beaucoup

A voir également:

1 réponse

ccm81 Messages postés 10903 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 19 novembre 2024 2 428
Modifié par ccm81 le 26/09/2011 à 11:09
bonjour

une proposition

Const cle As String = "##RES##" 
Const finmot As String = "##" 

Public Function extract(ByVal s As String) As String 
Dim p1 As Long, p2 As Long 
If s = "" Then 
  extract = "" 
Else 
  p1 = InStr(1, s, cle) 
  If p1 > 0 Then 
    s = Right(s, Len(s) - p1 - Len(cle) + 1) 
    p2 = InStr(1, s, finmot) 
    If p2 > 0 Then 
      extract = Left(s, p2 - 1) & ";" & extract(Right(s, Len(s) - p2 - 1)) 
    Else 
      extract = s 
    End If 
  End If 
End If 
End Function 


bonne suite
0
Bien joué ccm81.
Merci beaucoup !
0