Discussion :

[nivk-539]

Bonjour le forum,

J'ai un code pour extraire une chaine délimitée par des caractères.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Sub ExempleExtractionDeChaine()
 
On Error GoTo ExempleErreur
Dim ChaineOriginale1 As String
Dim ChaineOriginale2 As String
Dim LimiteGauche As String
Dim LimiteDroite As String
 
ChaineOriginale1 = "10231-125-00"
'ChaineOriginale1 = "24045-000-00"
LimiteGauche = ""
LimiteDroite = Mid(ChaineOriginale1, InStrRev(ChaineOriginale1, "-"))
 
User1 = ExtraireChaineDelimitee(ChaineOriginale1, LimiteGauche, LimiteDroite)
 
MsgBox User1
Exit Sub
ExempleErreur:
        MsgBox "Une erreur est survenue..."
End Sub
 
Public Function ExtraireChaineDelimitee(ChaineSource As String, Optional LimiteAvant As String = "", Optional LimiteApres As String = "")
 
On Error GoTo FunctionErreur
If InStr(1, ChaineSource, LimiteAvant) = 0 Then
    ExtraireChaineDelimitee = CVErr(xlErrNA)
    Exit Function
Else
    ExtraitPositionDebut = InStr(1, ChaineSource, LimiteAvant) + Len(LimiteAvant)
End If
 
If LimiteApres = "" Then
    ExtraitPositionFin = Len(ChaineSource)
Else
    ExtraitPositionFin = InStr(1, ChaineSource, LimiteApres) - 1
End If
ExtraireChaineDelimitee = Mid(ChaineSource, ExtraitPositionDebut, ExtraitPositionFin - ExtraitPositionDebut + 1)
Exit Function
 
FunctionErreur:
    ExtraireChaineDelimitee = CVErr(xlErrNA)
End Function
 
If LimiteDroite Like "-00" Then
    ChaineOriginale1 = Replace(ChaineOriginale1, "-000" & LimiteDroite, "-100" & LimiteDroite)
End If

Dans le premier cas ChaineOriginale1 vaut "10231-125-00" et donc mon User1 est ainsi égal à 10231-125. Pour ce cas là pas de soucis.
Par contre si ChaineOriginale1 vaut "24045-000-00" mon User1 sort seulement en 24045 alors que je le voudrais en "24045-000"

J'ai essayé cette solution qui marche mais je voudrais éviter cette méthode Replace et avoir quelque chose de plus optimisé. Quelqu'un aurait-il une idée ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Sub ExempleExtractionDeChaine()
 
On Error GoTo ExempleErreur
Dim ChaineOriginale1 As String
Dim ChaineOriginale2 As String
Dim LimiteGauche As String
Dim LimiteDroite As String
 
ChaineOriginale1 = "24045-000-00"
LimiteGauche = ""
LimiteDroite = Mid(ChaineOriginale1, InStrRev(ChaineOriginale1, "-"))
 
If LimiteDroite Like "-00" Then
    ChaineOriginale1 = Replace(ChaineOriginale1, "-000" & LimiteDroite, "-100" & LimiteDroite)
End If
 
 
User1 = ExtraireChaineDelimitee(ChaineOriginale1, LimiteGauche, LimiteDroite)
 
MsgBox User1
Exit Sub
ExempleErreur:
        MsgBox "Une erreur est survenue..."
End Sub
 
Public Function ExtraireChaineDelimitee(ChaineSource As String, Optional LimiteAvant As String = "", Optional LimiteApres As String = "")
 
On Error GoTo FunctionErreur
If InStr(1, ChaineSource, LimiteAvant) = 0 Then
    ExtraireChaineDelimitee = CVErr(xlErrNA)
    Exit Function
Else
    ExtraitPositionDebut = InStr(1, ChaineSource, LimiteAvant) + Len(LimiteAvant)
End If
 
If LimiteApres = "" Then
    ExtraitPositionFin = Len(ChaineSource)
Else
    ExtraitPositionFin = InStr(1, ChaineSource, LimiteApres) - 1
End If
ExtraireChaineDelimitee = Mid(ChaineSource, ExtraitPositionDebut, ExtraitPositionFin - ExtraitPositionDebut + 1)
Exit Function
 
FunctionErreur:
    ExtraireChaineDelimitee = CVErr(xlErrNA)
End Function

[Menhir]

Pour la recherche de la position de fin, utilises InStrRev() à la place de InStr().
https://docs.microsoft.com/fr-fr/off...trrev-function

[MarcelG]

Salut,

Personnellement, j'utiliserais une méthode Split basée sur le séparateur "-".
Il suffirait ensuite d'en concaténer les 2 premiers éléments, séparés par un "-"

[nivk-539]

Marcel G merci pour ton conseil!

J'ai procédé comme ceci et ça marche

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub ExempleExtractionDeChaine()
 
On Error GoTo ExempleErreur
Dim ChaineOriginale1 As String
Dim LimiteGauche As String
Dim LimiteDroite As String
 
ChaineOriginale1 = "24045-000-00"
'ChaineOriginale1 = "1023-110-00"
LimiteGauche = ""
LimiteDroite = Mid(ChaineOriginale1, InStrRev(ChaineOriginale1, "-"))
 
If LimiteDroite Like "-00" Then
    User1 = Split(ChaineOriginale1, "-")(0) & "-" & Split(ChaineOriginale1, "-")(1)
Else
    User1 = ExtraireChaineDelimitee(ChaineOriginale1, LimiteGauche, LimiteDroite)
End If
 
MsgBox User1
Exit Sub
ExempleErreur:
        MsgBox "Une erreur est survenue..."
End Sub
 
Public Function ExtraireChaineDelimitee(ChaineSource As String, Optional LimiteAvant As String = "", Optional LimiteApres As String = "")
 
On Error GoTo FunctionErreur
If InStr(1, ChaineSource, LimiteAvant) = 0 Then
    ExtraireChaineDelimitee = CVErr(xlErrNA)
    Exit Function
Else
    ExtraitPositionDebut = InStr(1, ChaineSource, LimiteAvant) + Len(LimiteAvant)
End If
 
If LimiteApres = "" Then
    ExtraitPositionFin = Len(ChaineSource)
Else
    ExtraitPositionFin = InStr(1, ChaineSource, LimiteApres) - 1
End If
ExtraireChaineDelimitee = Mid(ChaineSource, ExtraitPositionDebut, ExtraitPositionFin - ExtraitPositionDebut + 1)
Exit Function
 
FunctionErreur:
    ExtraireChaineDelimitee = CVErr(xlErrNA)
End Function

[patricktoulon]

bonjour
ca fait un sacré mouliné pour une extraction on ne peut plus simple d'une chaine tel que présenté
seul intrrev suffit !!!
sauf que au lieu de tester"-00" il faut tester"-000" avant tout simplement

ca c'est pour le principe de base

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub test()
MsgBox user([A1].Text)
MsgBox user([A2].Text)
MsgBox user("25310-65-00")
End Sub
'
Function user(chaine As String) As String
x = InStrRev(chaine, "-000") + 4
If x = 4 Then x = InStrRev(chaine, "-00")
user = Mid(chaine, 1, x - 1)
End Function

maintenant!!!!! faudrait peu etre penser aux eventuelles erreur du a l'absence de "-00" ou "-000" SI!!! VRAIMENT SE SONT LES DELIMITEURS

ben pareil on fait simple
on a alors le controle sur la validité de la chaine

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub test2()
MsgBox user([A1].Text)
MsgBox user([A2].Text)
MsgBox user("23125-452-15")
End Sub
'
Function user(chaine As String) As String
x = InStrRev(chaine, "-000") + 4
If x = 4 Then x = InStrRev(chaine, "-00")
If x = 0 Then user = "Invalid String" Else user = Mid(chaine, 1, x - 1)
End Function

pourquoi faire simple quand on peut faire compliqué

de meme que l'on pourrrait se servir du 3ème argument de la fonction instRev en ne testant que "-00"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub test3()
MsgBox user([A1].Text)
MsgBox user([A2].Text)
MsgBox user("23125-452-15")
End Sub
'
Function user(chaine As String) As String
x = InStrRev(chaine, "-00", Len(chaine) - 3) + 3
If x = 3 Then x = InStrRev(chaine, "-00", Len(chaine)) - 1
If x = -1 Then user = "Invalid String" Else user = Mid(chaine, 1, x)
End Function

et encore de la meme maniere mais cette fois ci avec la fonction instr indexé dans le 1er argument

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub test4()
MsgBox user([A1].Text)
MsgBox user([A2].Text)
MsgBox user("23125-452-15")
End Sub
'
Function user(chaine As String) As String
x = InStr(1, chaine, "-000") + 3
If x = 3 Then x = InStr(1, chaine, "-00") - 1
If x = -1 Then user = "Invalid String" Else user = Mid(chaine, 1, x)
End Function

[nivk-539]

Salut Patrick,

En effet plutôt cool comme solution je n'y avais pas pensé!
Merci bien