Macro pour supprimer des tirets sauf si le tiret est unique

Bonjour à tous,

Je sollicite votre aide pour automatiser une fonction qui a l'air, comme souvent, toute bête et pourtant je n'ai trouvé aucun exemple sur internet qui corresponde à ce dont j'ai besoin (et clairement je ne suis pas un spécialiste du VBA...).

Je dispose de données qui me sont communiquées dans un format inexploitable sans les "nettoyer".

Il y a en effet des tirets intempestifs au nombre aléatoire dans à peu près toutes les cellules de la base de données.

Evidemment, il serait simple de faire rechercher / remplacer les tirets : c'est ce que j'ai fait (cf. macro dans l'exemple joint).

Sub remplacer_tiret()

Application.ScreenUpdating = False

With Sheets("Feuil1")

.Range("A:D").Cells.Replace What:="-", Replacement:=""

End With

End Sub

Mais le problème c'est que dans le cas où le tiret est unique, il ne faut pas le supprimer car il peut correspondre notamment à un montant négatif ou à un séparateur de mots composés.

En clair, à la macro rechercher / remplacer tous les tirets par rien il faut rajouter la condition suivante s'il y a au moins deux tirets dans la cellule.

Quelqu'un a une idée ?

Merci d'avance !

37exemple.xlsm (14.45 Ko)

Bonjour,

Une possibilité en pièce jointe.

A+

111substpopeye.xlsm (14.52 Ko)

Je te remercie ça fonctionne parfaitement !

Si je comprends bien ce que tu as fais, c'est prévoir de remplacer les "suites de tirets" de 2, puis de 3, (...) et enfin de 10 caractères et cela permet de tenir compte de toutes les situations c'est bien ça ? Idem pour les espaces !

Par curiosité je m'interroge quand même sur la possibilité de faire une macro sans devoir adopter cette méthode empirique (c'est le mot qui me vient, je ne sais pas comment la décrire autrement).

Bonsoir,

une autre proposition

Sub aargh()
    Set c = ActiveSheet.UsedRange
    c.Replace "--", "µ"
    c.Replace "µ-", ""
    c.Replace "µ", ""
End Sub

edit (suppression de la boucle)

Bonsoir,

Hum... C'est la méthode bourrin ! Celle que j'utilise quand je ne veux pas me fatiguer...

Tu veux quelque chose de plus branché ?

Sub remplacer_tiret()
Application.ScreenUpdating = False
On Error Resume Next
With Sheets("Feuil1")
   For i = 10 To 2 Step -1
   S = String$(i, "-")
      .Range("A:D").Cells.Replace What:=S, Replacement:=""
      .Range("A:D").Cells.Replace What:=Space(i), Replacement:=""
   Next
End With
End Sub

A+

Merci Galopin et h2so4 ! C'est vraiment impeccable

J'avoue c'est la grande classe

Rechercher des sujets similaires à "macro supprimer tirets sauf tiret unique"