VBA : split cellule en 2 parties (choix séparateur et de sa position)

[zebanx]

Bonjour,

Essayant de répondre à un autre post concernant une récupération d'une partie du texte (pas d'espace et longueur variable) d'une cellule, je tente de créer un code qui me permette :
- de séparer les Chiffres et les Lettres (avec l'aide d'une fonction récupérée ReNSpace qui crée un espace entre les deux blocs sur toute la longueur de la cellule ) = ok
- de choisir le séparateur ([G1]) et le numéro de séparateur ([G2]) pour scinder la cellule en début_texte et fin_texte avec l'utilisation de InStr et Mid.

Pour cette deuxième partie (colonne C et D), cela fonctionne plutôt bien quand les cellules ont les mêmes informations (3" ", 2"_", 3"/") mais les résultats sont étranges par exemple quand je tente d'extraire le troisième "_" qui n'existe que sur la cellule B14 (résultats corrects en C14 et D14 mais pas sur les cellules au-dessus).

Pourriez-vous me corriger le code svp ou me fournir une recette maison qui permettrait d'aboutir au même résultat ?

Vous en remerciant par avance, cdlt
zebanx

--- code --
Sub extractionD()
Dim k As Variant
Dim j As Integer, derligne, i, m

derligne = Cells(Rows.Count, 1).End(xlUp).Row

k = Cells(1, 7).Value
j = Cells(2, 7).Value

Range(Cells(3, 3), Cells(derligne, 4)).ClearContents

On Error Resume Next
For i = derligne To 3 Step -1
m = InStr(1, Cells(i, 2), Split(Cells(i, 2), k)(j))
Cells(i, 4) = Replace(Mid(Cells(i, 2), m - 1, 100), " ", "")
Cells(i, 3) = Replace(Mid(Cells(i, 2), 1, m - 1), " ", "")
Next i
End Sub

 

[zebanx]

Bonjour à tous,

Pas de réponse encore.., je pensais que c'était explicite (visiblement non et ce serait intéressant svp d'avoir votre retour là-dessus) et utile d'avoir à choisir son séparateur et sa position plutôt que de trainer des droite / gauche .

Le problème a cependant pu être contourné en trouvant sur internet une solution acceptable pour ne plus utiliser le "on error resume next" = SUJET CLOS -)

Le code modifié serait le suivant :

Sub extractionD()
Dim k As Variant
Dim j As Integer, derligne, i, m
Dim strTab() As String

derligne = Cells(Rows.Count, 1).End(xlUp).Row

k = Cells(1, 8).Value
j = Cells(2, 8).Value

Range(Cells(3, 3), Cells(derligne, 4)).ClearContents

For i = derligne To 3 Step -1
strTab = Split(Cells(i, 2), k)
If UBound(strTab()) > 0 And UBound(strTab()) >= j Then
m = InStr(1, Cells(i, 2), Split(Cells(i, 2), k)(j))
Cells(i, 4) = Replace(Mid(Cells(i, 2), m - 1, 100), " ", "")
Cells(i, 3) = Replace(Mid(Cells(i, 2), 1, m - 1), " ", "")
Else
Cells(i, 3) = Replace(Cells(i, 2), " ", "")
End If
Next i
End Sub

 

[pierrejean]

Bonjour zebanx

Voir colonne E (fonction extrait)

 

[zebanx]

Bonjour zebanx
Voir colonne E (fonction extrait)

Bonjour Pierre-Jean

Très efficace et code synthétique -)

J'avais récupéré un UDF bien plus long mais qui pourrait vous intéresser également, si vous ne le connaissez pas déjà.

http://excel-malin.com/codes-sources-vba/extraire-chaine-de-caracteres-delimitee/

Bonne soirée.
zebanx