XL 2019 trouver toutes les occurrences d'un caractère dans une chaine

[teclim]

Bonjour,
Je débute en vba et j'ai un souci avec la suppression d'une partie du texte d'une cellule.
Voila ce que j'ai au départ:

mais après suppression de la fin du texte avec la fonction mid() j'obtiens ceci :

Comment je peux supprimer du texte en gardant la mise en forme du texte ?
D'avance merci.

 

[job75]

Bonjour teclim,

La solution est de stocker les propriétés des caractères dans des tableaux.

Puis de les restituer après modification du texte de la cellule :

Sub ConserverFormatTexte()
Dim cel As Range, supr%, conserve$, i%, a(), b()
Set cel = [A1] 'à adapter
supr = 62 'nombre de caractères à supprimer en fin de texte, à adapter
conserve = Left(cel.Text, Len(cel.Text) - supr)
For i = 1 To Len(conserve)
    ReDim Preserve a(1 To i): a(i) = cel.Characters(i, 1).Font.Color 'couleur
    ReDim Preserve b(1 To i): b(i) = cel.Characters(i, 1).Font.Bold 'gras
Next i
cel = conserve 'modifie le texte
For i = 1 To Len(conserve)
    cel.Characters(i, 1).Font.Color = a(i)
    cel.Characters(i, 1).Font.Bold = b(i)
Next i
cel.EntireRow.AutoFit 'ajustement hauteur, facultatif
End Sub

A+

 

[job75]

Vous n'avez pas donné suite à ce fil, j'espère que ce n'est qu'un oubli :

https://excel-downloads.com/threads...s-depuis-une-fonction.20083561/#post-20650053

 

[kiki29]

Salut, voir via RegEx ?

 

[teclim]

Vous n'avez pas donné suite à ce fil, j'espère que ce n'est qu'un oubli :

https://excel-downloads.com/threads...s-depuis-une-fonction.20083561/#post-20650053

Oui effectivement je suis focalisé sur ces macros. C'est corrigé.

 

[job75]

Et la solution de ce fil-ci ?

 

[teclim]

J'ai adapté la solution de job75 et ça fonctionne.
Juste ça prend un peu de temps (moins que si je le faisait à la main)
Merci.

 

[job75]

Juste ça prend un peu de temps

Pour accélérer mettez Application.ScreenUpdating = False en début de macro.

 

[teclim]

Merci ça fait gagné du temps.