Code vba pour extraire une chaîne spécifique de caractéres

**samy35** · 24/09/2013, 11h15

Bonjour;
j'ai des difficultés pour extraire une chaîne de caractère voici mon exemple:

j'ai la colonne A qui contient ce genre de caractère (je n'ai mis que 2 lignes comme exemple)

1- BBBB - SAAAT\Agrandissement\ Capturs\Centre Ouest\LC510 - PALM BEACH SUD\Etat commutateur Manuel 3

2- BBBB - SAAAT\ Potable\Capturs\Sectorisation\Zones FFF - Chaîne côtière\Débit LC270 - Azur Plage

je veux extraire juste la chaine qui débute par LC et qui se termine avant le "\"
(exp: LC510 - PALM BEACH SUD) et (LC270 -Azure plage) et les mettre dans 2 colonnes séparés exp:
B

c

LC510

PALM BEACH SUD

LC270

Azure plage

merci d'avance.

**EngueEngue** · 24/09/2013, 11h31

La galère...
Supposons qu'en A1:A1000 tu aies tes chaînes de caractères immondes.

En Z1 tu mets

Code :

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

=GAUCHE(DROITE(A1;NBCAR(A1)-CHERCHE("LC";A1)+1);SIERREUR(CHERCHE("\";DROITE(A1;NBCAR(A1)-CHERCHE("LC";A1)+1))-1;NBCAR(DROITE(A1;NBCAR(A1)-CHERCHE("LC";A1)+1))))

Et tu traines jusqu'à Z1000...

Puis en B1 tu mets:

Code :

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

=GAUCHE(Z1;5)

Et en C1:

Code :

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

=DROITE(Z1;NBCAR(Z1)-8)

Et si tu veux te passer de la colonne Z1...
B1=

Code :

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

=GAUCHE(GAUCHE(DROITE(A1;NBCAR(A1)-CHERCHE("LC";A1)+1);SIERREUR(CHERCHE("\";DROITE(A1;NBCAR(A1)-CHERCHE("LC";A1)+1))-1;NBCAR(DROITE(A1;NBCAR(A1)-CHERCHE("LC";A1)+1))));5)

C1=

Code :

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

=DROITE(GAUCHE(DROITE(A1;NBCAR(A1)-CHERCHE("LC";A1)+1);SIERREUR(CHERCHE("\";DROITE(A1;NBCAR(A1)-CHERCHE("LC";A1)+1))-1;NBCAR(DROITE(A1;NBCAR(A1)-CHERCHE("LC";A1)+1))));NBCAR(GAUCHE(DROITE(A1;NBCAR(A1)-CHERCHE("LC";A1)+1);SIERREUR(CHERCHE("\";DROITE(A1;NBCAR(A1)-CHERCHE("LC";A1)+1))-1;NBCAR(DROITE(A1;NBCAR(A1)-CHERCHE("LC";A1)+1)))))-8)

**Marc-L** · 24/09/2013, 11h36

Bonjour,

vite fait en passant, ce n'est pas une galère en VBA si c'est toujours la même chaine "LC" à extraire
et toujours le tiret pour effectuer la séparation en colonne.

A suivre …

Invité · 24/09/2013, 11h38

Un simple:

Code :

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

=GAUCHE(DROITE(A1;NBCAR(A1)-CHERCHE("LC";A1)+1);5)

devrait suffire avec la chaine de texte à extraire dans la colonne A.

Après s'il y a plusieurs occurrences de "LC" dans la même ligne...

EDIT: J'avais pas vu la deuxième colonne...

**EngueEngue** · 24/09/2013, 11h39

non en vba c'est plus simple, mais le creusage de tête excel m'a fait du bien

**spookyz** · 24/09/2013, 11h55

Bonjour à tous,
essaye ça

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
Sub separ()
 
For i = 1 To 2
lachaine = Cells(i, 1)
posilc = InStr(1, lachaine, "LC", 0)
posisla = InStr(posilc, lachaine, "\", 0)
longchai = posisla - posilc
chaine1 = Mid(lachaine, posilc, longchai)
leschaines = Split(chaine1, "-")
 
Cells(i, 2) = leschaines(0)
Cells(i, 3) = leschaines(1)
 
Next i
End Sub

par contre dans ton exemple la deuxieme ligne ne fini pas par le \
ça pose probleme pour ce que je te propose mais on peu l'arranger
cordialement

**samy35** · 24/09/2013, 12h31

Merci beaucoup pour vos réponses;

j'ai testé toutes vos réponses mais c'est celle de EngueEngue qui m'a résolue mon problème, Mais bon je voulais en code vba mais c'est déjà pas mal car elle me donne un coup de pouce.

celle de vcottineau marche aussi ! j'aurais aimé que le code vba de Spookyz marche car il est en vba et ça aurait été une vrai solution pour moi!

j'aimerai bien l'avoir en vba car je suis nulle en programmation!

merci.

**EngueEngue** · 24/09/2013, 12h36

Il te suffit de creer une fonction qui va te mettre la formule dans ton target...

**spookyz** · 24/09/2013, 12h38

Si tu a la solution a ton problème pense a le mettre en résolu
sinon dit moi ce qui ne fonctionne pas dans le code que je te propose

**samy35** · 24/09/2013, 12h41

Spookzy
le code s'arrette à la ligne

Code :

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

posisla = InStr(posilc, lachaine, "\", 0)

je ne sais pas pourquoi?

**EngueEngue** · 24/09/2013, 12h47

parce qu'il n'y a pas de "\" dans lachaine...

C'est pourquoi mon sierreur et la galère

**Marc-L** · 25/09/2013, 01h51

La suite … Supposant la première ligne réservée aux titres des colonnes (facilement adaptable sinon) :

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
Function Extrait(TXT$, DEB$, FIN$, Optional SEP$)
    D& = InStr(TXT, DEB)
 
    If D Then
         ReDim E$(0)
         F& = InStr(D + Len(DEB), TXT, FIN)
         If F Then E(0) = Mid$(TXT, D, F - D) Else E(0) = Mid$(TXT, D)
 
         If SEP > "" Then
            E = Split(E(0), SEP)
            For F = 0 To UBound(E):  E(F) = Trim$(E(F)):  Next
         End If
 
         Extrait = E
    End If
End Function
 
 
Sub DemoExtraction()
    Application.ScreenUpdating = False
 
    For R& = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        EX = Extrait(Cells(R, 1).Value, "LC", "\", "-")
        If IsArray(EX) Then Cells(R, 2).Resize(, UBound(EX) + 1).Value = EX
    Next
 
    Application.ScreenUpdating = True
End Sub

__________________________________________________________________________________________

Merci de cliquer sur

pour chaque message ayant aidé puis sur

pour clore cette discussion …

__________________________________________________________________________________________
La théorie, c'est quand on sait tout et que rien ne fonctionne. La pratique, c'est quand tout fonctionne et que l'on ne sait pourquoi …

**EngueEngue** · 25/09/2013, 09h59

Joli

**Marc-L** · 25/09/2013, 10h39

Et là encore j'ai fait simple, l'extraction d'une sous-chaîne étant de niveau débutant,
l'idée de départ étant de tout scanner d'un bloc par variables tableau mais c'est moins abordable pour les novices …

Déjà comme cela la procédure est quelque peu accélérée en inscrivant les données dans les colonnes d'une ligne
en une seule fois au lieu d'alimenter chaque colonne individuellement …

**EngueEngue** · 25/09/2013, 11h31

Oui, tes codes sont les plus beaux qu'on voit par ici

**Marc-L** · 25/09/2013, 11h59

**samy35** · 25/09/2013, 12h10

Bravo Marc-L!
ça marche très bien! je te remercie infiniment.
sauf pour un cas qui s'est présenté

exp de cette ligne:

BBBB - SAAAL\POTABLE\Capturs\Sectorisation\Etage \Volume TC005 - PHASE - réservoirs1-2

le code ma coupé la chaîne réservoir dans la colonne D et 2 dans la colonne E alors que moi je ne veux pas de ces 2 colonnes!

**Marc-L** · 25/09/2013, 15h22

La prochaine fois, merci de faire une présentation exhaustive … Et dire que j'avais prévu le cas où il y aurait plus de colonnes !

Deux solutions :

soit réduire la plage destination dans la procédure, juste modifier la ligne n°24 ainsi :

If IsArray(EX) Then Cells(R, 2).Resize(, Application.Min(UBound(EX) + 1, 2)).Value = EX …

soit compléter la fonction par un argument optionnel limitant le nombre de colonnes (voir les lignes n°1, 11 & 24) :

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
Function Extrait(TXT$, DEB$, FIN$, Optional SEP$, Optional MAX%)
    D& = InStr(TXT, DEB)
 
    If D Then
         ReDim E$(0)
         F& = InStr(D + Len(DEB), TXT, FIN)
         If F Then E(0) = Mid$(TXT, D, F - D) Else E(0) = Mid$(TXT, D)
 
         If SEP > "" Then
            E = Split(E(0), SEP)
            If MAX And UBound(E) > MAX - 1 Then ReDim Preserve E(MAX - 1)
            For F = 0 To UBound(E):  E(F) = Trim$(E(F)):  Next
         End If
 
         Extrait = E
    End If
End Function
 
 
Sub DemoExtraction()
    Application.ScreenUpdating = False
 
    For R& = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        EX = Extrait(Cells(R, 1).Value, "TC", "\", "-", 2)
        If IsArray(EX) Then Cells(R, 2).Resize(, UBound(EX) + 1).Value = EX
    Next R
 
    Application.ScreenUpdating = True
End Sub

__________________________________________________________________________________________

Merci de cliquer sur

pour chaque message ayant aidé puis sur

pour clore cette discussion …

__________________________________________________________________________________________
Un scientifique lira des centaines de livres au cours de sa vie, mais sera toujours persuadé qu'il lui reste beaucoup à apprendre.
Un religieux n'en lira qu'un et sera persuadé d'avoir tout compris …