[XL-2010] Substitute erreur (retrait de caractère en fin de cellule)

**g.terro** · 03/11/2016, 14h08

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** · 03/11/2016, 16h52

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** · 03/11/2016, 19h59

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** · 04/11/2016, 08h46

Envoyé par unparia

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** · 04/11/2016, 09h22

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** · 04/11/2016, 11h04

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** · 07/11/2016, 15h05

Bonjour, Un grand merci

**patricktoulon** · 07/11/2016, 16h00

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

**Philippe Tulliez** · 07/11/2016, 17h19

Bonjour Patrick,

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

J'avais pensé à cette solution mais si tu lis bien la demande initiale on parle bien de caractères placés à la fin et donc la fonction REPLACE risque d'ôter des caractères " *" que l'on souhaiterait conserver.
La réponse de Menhir est donc tout à fait pertinente par rapport à cette demande.

**unparia** · 07/11/2016, 17h55

ou encore

Code :

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

1
2
3
4
5
6
7
8
Private Function enleve_aster_final(c As String) As String
  If c Like "*[*]" Then
    Mid(c, Len(c), 1) = " "
    enleve_aster_final = RTrim(c)
  Else
    enleve_aster_final = c
  End If
End Function

ou encore

Code :

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

1
2
3
4
5
Private Function enleve_aster_final(c As String) As String
  titi = Split(StrConv(c, vbUnicode), Chr(0))
  If titi(UBound(titi) - 1) = "*" Then titi(UBound(titi) - 1) = ""
  enleve_aster_final = RTrim(Join(titi, ""))
End Function

etc .... nombre énorme de possibilités de traitement...

**patricktoulon** · 07/11/2016, 18h13

Envoyé par Philippe Tulliez

Bonjour Patrick,

J'avais pensé à cette solution mais si tu lis bien la demande initiale on parle bien de caractères placés à la fin et donc la fonction REPLACE risque d'ôter des caractères " *" que l'on souhaiterait conserver.
La réponse de Menhir est donc tout à fait pertinente par rapport à cette demande.

oh! purée j'ai honte , tu a absolument raison Philippe je mérite un -1 rien que pour ca

c'est incroyable que quelque chose comme ca m'ai échappé

je vais prendre des vacances

j'avais opter aussi pour une fonction du style de unparia mais sa formulation m'est un peu obscure sur son mid je vais étudier ca

je vais tout de suite me cacher

re
ok après test la fonction de unparia fonctionne mais elle a le même soucis en fait
elle ne prends pas en compte le fait que le "*" soit a la fin puis que le test se fait sur un like chaine complète

j'ignorais que l'on pouvait modifier une chaine de cette manière et attribuer un caractère directement sur le mid (chaine, debut,fin)="..."

merci pour ca unparia

re

oulah!! unparia tu t'égare ta premiere était bien seule la condition était a modifier

Code :

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

1
2
3
4
5
6
7
8
Private Function enleve_aster_final(c As String) As String
  If rigth(c,1)="*" Then
    Mid(c, Len(c), 1) = " "
    enleve_aster_final = RTrim(c)
  Else
    enleve_aster_final = c
  End If
End Function

on a le test de présence et le fait que cela soit bien la fin de la chaine tout simplement

on pourrait même se passer du else

Code :

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

1
2
3
4
5
6
7
Private Function enleve_aster_final(c As String) As String
   enleve_aster_final = c
 If rigth(c,1)="*" Then  
   Mid(c, Len(c), 1) = " "
     enleve_aster_final = RTrim(c)
    End If
End Function