Discussion :

[g.terro]

Bonjour,

Je souhaite à l'aide d'une macro modifier un ensemble de cellule déjà sélectionnées.
A savoir, ajouter à la fin du contenu de chaque cellule un caractère étoile *
J'y suis parvenu grâce à:

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub AppendToExistingOnRight()
Dim c As Range
For Each c In Selection
If c.Value <> "" Then c.Value = c.Value & " *"
Next
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
End Sub

Je souhaite désormais pouvoir disposer du code VBA pour retirer ces étoiles *.
Le code suivant ne fonctionne pas

Code :

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

1
2
3
4
5
6
Sub removeToExistingOnRight()
Dim c As Range
For Each c In Selection
If c.Value <> "" Then c.Value = Substitute(c.Value, "*", "")
Next
End Sub

une piste SVP
merci

[Menhir]

Essaye ça :

Code :

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

1
2
3
4
5
6
Sub removeToExistingOnRight()
    Dim c As Range
    For Each c In Selection
        If Right(c.Value, 1) = "*" Then c.Value = Left(c.Value, Len(c.Value))
    Next c
End Sub

[unparia]

Bonjour ami Menhir
T'oublierais pas un -1 "quelque part" ? (la longueur ...) ?
Corrige avant que le demandeur n'arrive en disant "fonctionne pas", sans même analyser.
Amitiés

[Menhir]

T'oublierais pas un -1 "quelque part" ? (la longueur ...) ?

Exact. Merci.
La correction :

Code :

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

1
2
3
4
5
6
Sub removeToExistingOnRight()
    Dim c As Range
    For Each c In Selection
        If Right(c.Value, 1) = "*" Then c.Value = Left(c.Value, Len(c.Value)-1)
    Next c
End Sub

[Philippe Tulliez]

Bonjour,
Si je lis bien, la procédure AppendToExistingOnRight ajoute un caractère espacé + l'astérisque alors que la procédure removeToExistingOnRight supprime l'astérisque. Il subsiste donc un caractère espacé.

[Menhir]

Je n'avais pas remarqué.
Donc :

Code :

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

1
2
3
4
5
6
Sub removeToExistingOnRight()
    Dim c As Range
    For Each c In Selection
        If Right(c.Value, 2) = " *" Then c.Value = Left(c.Value, Len(c.Value)-2)
    Next c
End Sub

[/QUOTE]

[g.terro]

Bonjour, Un grand merci

[patricktoulon]

Bonjour
en utilisant "replace" tu te dé doine de toute autre condition que le if "" sur la cellule et autre gestion d'erreur

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub ajoute()
Dim c As Range
For Each c In Selection
If c.Value <> "" Then c.Value = Replace(c.Value, c.Value, c.Value & " *")
Next
End Sub
 Sub enleve()
Dim c As Range
For Each c In Selection
If c.Value <> "" Then c.Value = Replace(c.Value, " *", "")
Next
End Sub