Extraire sous chaine de caractère et supprimer ceux inutiles
Bonjour,
J'ai un problème que je n'arrive pas à résoudre concernant la manipulation de chaines de caractères.
J'ai par exemple dans ma cellule A3 une chaine comme ceci : name-1-2-3-/-/-6-7-8-/-X-11-12-13-14-X-16-/-/-/
J'extrait tout d'abord que la partie "1-2-3-/-/-6-7-8-/-X-/-12-13-14-X-16" avec Mid (Range("A3"),6).
Ensuite je supprime les derniers caractères ("-/") avec ce code :
Sub supprimer()
Do While Right(Range("A3"), 2) = "-/"
Range("A3") = Left(Range("A3"), Len(Range("A3")) - 2)
Loop
End SubPar contre ce que j'aimerai faire maintenant, c'est d'extraire tout d'abord les parties gauches et droites après chaque et avant chaque "-/-" et "-X-", c'est à dire de ne garder que "1-2-3", "6-7-8" , "12-13-14" et "16". Puis dans ces plages de caractères, le but serait de supprimer les chiffres au milieu afin d'obtenir au final => name-3-/-/-6-8-/-X-12-14-X-16. Du coup en effet le 1 ne doit pas être gardé car c'est le premier chiffre de la série. Par contre si je n'ai que "name-1" au début, je ne souhaite pas le supprimer... Je suis conscient que c'est assez complexe mais je suis assez novice en VBA et je ne vois pas très bien comment faire ...
Autres exemples :
"name-1-2-/-/-/" => "name-2"
"name-1-2-X-4-5-6-7-8-/-X-/-12-13-14-/-/-17-18-19-/-/" => "name-2-X-4-8-/-X-/-12-14-/-/-17-19"
"name-1-2-3-4-5-/-7-/-/" => "name-5-/-7"
Boujour Nivk, bonjour le forum,
Moi je dis : un petit fichier exemple avec une dizaine de cas bien sentis dans l'onglet 1 et le résultat voulu dans l'onglet 2 serait bien plus utile que tous ce blabla...
Bonjour ThauThème,
En effet désolé je n'ai pas très bien expliqué ...
Voici un fichier comme tu m'as demandé
Re,
Désolé mais je ne vois pas comment automatiser ça ! Je n'ai pas trouvé la logique.
Regarde peut-être du coté de Split...
Oui en effet pas simple j'ai du mal moi aussi... Je vais tout de même continuer à creuser
Bonjour,
Je pense avoir une solution mais il me reste à voir si ça marche comme il faut, je te fais un retour dans l'après-midi
Me revoilà, je te propose cette solution:
J'ai regardé si ça correspondait à tes attentes, et ça me semble bon, je te laisse voir par toi-même
Super AuSecour c'est exactement ce que je voulais merci !!
Je l'ai juste adapté par rapport à mon cas :
Sub test()
Dim posX, posSlash, posFin
Dim rng As Range
Dim MaChaine As String, i As Long
Dim Insert As String
Set rng = Sheets(1).Range("A1")
If Not rng.Value = "name-1" Then
If Right(rng.Value, 4) Like "-/-/" Then
texte = ""
chaine = ""
indice = 0
nom = Left(rng, InStr(1, rng, "-") - 1)
curseur = Len(nom) + 1
Do
If Not Mid(rng, curseur) Like "*#*" Then Exit Do 'vérifie qu'il reste des nombres à mettre
'calcul de la position de fin de la chaine à traiter
posX = InStr(curseur, rng, "-X-")
posSlash = InStr(curseur, rng, "-/-")
If posX > posSlash Or posX = 0 Then
posFin = posSlash
Else
posFin = posX
End If
If posFin = 0 Then Exit Do
texte = texte & IIf(chaine = "-/", "-/", "")
'changement de la variable chaine
If posFin = posSlash Then
chaine = "-/"
Else
chaine = "-X"
End If
nombredep = ""
nombrefin = ""
carpred = ""
'parcours de tous les caractères entre le curseur et la fin
For h = curseur To posFin - 1
car = Mid(rng, h, 1)
If IsNumeric(car) Then
If IsNumeric(carpred) Then
If nombrefin <> "" Then
nombrefin = nombrefin & car
Else
nombredep = nombredep & car
End If
Else
If nombredep <> "" Then
nombrefin = car
Else
nombredep = car
End If
End If
End If
carpred = car
Next h
'enregistrement des nombres dans la variable texte
If indice = 0 Then
texte = "-" & IIf(nombrefin <> "", nombrefin, nombredep)
Else
texte = texte & IIf(nombredep <> "", "-" & nombredep, "") & IIf(nombrefin <> "", "-" & nombrefin, "") _
End If
texte = texte & IIf(chaine = "-X", "-X", "")
'incrémentations
curseur = posFin + Len(chaine)
indice = indice + 1
Loop
rng = nom & texte
ElseIf Not Right(rng.Value, 4) Like "-/-/" Then
rng.Value = rng.Value & Left(MaChaine, 2) & "-/-/"
texte = ""
chaine = ""
indice = 0
nom = Left(rng, InStr(1, rng, "-") - 1)
curseur = Len(nom) + 1
Do
If Not Mid(rng, curseur) Like "*#*" Then Exit Do 'vérifie qu'il reste des nombres à mettre
'calcul de la position de fin de la chaine à traiter
posX = InStr(curseur, rng, "-X-")
posSlash = InStr(curseur, rng, "-/-")
If posX > posSlash Or posX = 0 Then
posFin = posSlash
Else
posFin = posX
End If
If posFin = 0 Then Exit Do
texte = texte & IIf(chaine = "-/", "-/", "")
'changement de la variable chaine
If posFin = posSlash Then
chaine = "-/"
Else
chaine = "-X"
End If
nombredep = ""
nombrefin = ""
carpred = ""
'parcours de tous les caractères entre le curseur et la fin
For h = curseur To posFin - 1
car = Mid(rng, h, 1)
If IsNumeric(car) Then
If IsNumeric(carpred) Then
If nombrefin <> "" Then
nombrefin = nombrefin & car
Else
nombredep = nombredep & car
End If
Else
If nombredep <> "" Then
nombrefin = car
Else
nombredep = car
End If
End If
End If
carpred = car
Next h
'enregistrement des nombres dans la variable texte
If indice = 0 Then
texte = "-" & IIf(nombrefin <> "", nombrefin, nombredep)
Else
texte = texte & IIf(nombredep <> "", "-" & nombredep, "") & IIf(nombrefin <> "", "-" & nombrefin, "") _
End If
texte = texte & IIf(chaine = "-X", "-X", "")
'incrémentations
curseur = posFin + Len(chaine)
indice = indice + 1
Loop
rng = nom & texte
End If
Else
Exit Sub
End If
End SubBonjour
Super, c'était un peu casse-tête à coder mais si ça répond à tes attentes!
Merci d'avoir passé le sujet en résolu
Bonjour le fil, bonjour le forum,
Moi je dis "Chapeau bas" Ausecour !...
Salut ThauThème!
Merci