Supprime Caractères
Bonjour
J'ai dans un classeur une centaine de feuilles avec nom de ville. sur trois colonnes comme ceci:
Colonne "E" Belley (011)
Colonne "F" Ambérieu-en-Bugey (0101)
Colonne "G" L’Abergement-Clémenciat (01001)
J'aimerai à l'aide d'un code VBA supprimer les caractères en rouge (01001) en sachant qu'il y a environ 300 noms dans des colonnes
Mon fichier exemple
Je vous remercie
Max
Bonjour valmax,
Aucun texte ni caractère sont en rouges dans le fichier, les caractères à supprimer, sont-ils ceux qui se trouvent après "(" ?
Bonjour
Oui les caractères à supprimer sont les chiffres entre les guillemets et les guillemets. (01001)
Merci
Bonjour,
Une piste de suppression des codes postaux et des parenthèses (si j'ai bien compris la demande !)
La plager commence en E7 (L = 7, C = 5) :
Sub Test()
Dim Fe As Worksheet
Dim Plage As Range
Dim Cel As Range
Dim Pos As Integer
For Each Fe In Worksheets
Set Plage = DefPlage(Fe, 7, 5)
For Each Cel In Plage.Cells.SpecialCells(xlCellTypeConstants)
Pos = InStr(Cel.Value, " (")
If Pos <> 0 Then Cel.Value = Left(Cel.Value, Pos - 1)
Pos = 0
Next Cel, Fe
End Sub
Function DefPlage(Fe As Worksheet, Optional L As Long = 1, Optional C As Long = 1) As Range
On Error GoTo Fin
With Fe
Set DefPlage = .Range(.Cells(L, C), _
.Cells(.Cells.Find("*", .[A1], -4123, , _
1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
2, 2).Column))
End With
Exit Function
Fin:
Set DefPlage = Nothing
End FunctionBonjour,
à tester,
Sub remplace()
Dim keywords As String, firstAddress As String, c As Range
keywords = "("
With ActiveSheet.Cells
Set c = .Find(keywords, LookIn:=xlValues, LookAt:=xlPart)
If Not c Is Nothing Then
firstAddress = c.Address
Do
x = Application.Find("(", c.Value)
c = Left(c.Value, x - 1)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End SubBonjour i20100
Ton code fonctionne et après il me met un message d'erreur sur la ligne
Loop While Not c Is Nothing And c.Address <> firstAddress
Variable objet ou variable de bloc With non définie
Merci
Salut Florian
Je te remercie Nickel
Bonne après midi
Bonjour à tous,
@Florian53
Il y a un souci dans le code. Regarde la cellule G371.
Au départ La Tranclière (01425) et après traitement La
Cela est dû à l'espace entre La et Tranclière.
Phénomène idem en G227.
ric
Ton code fonctionne et après il me met un message d'erreur sur la ligne
Loop While Not c Is Nothing And c.Address <> firstAddress
à tester,
Sub remplace()
Dim keywords As String, firstAddress As String, c As Range
keywords = "("
With ActiveSheet.Cells
Set c = .Find(keywords, LookIn:=xlValues, LookAt:=xlPart)
If Not c Is Nothing Then
firstAddress = c.Address
Do
x = Application.Find("(", c.Value)
c = Left(c.Value, x - 1)
Set c = .FindNext(c)
On Error GoTo fin 'si la valeur n'est plus trouvée
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
fin:
End SubCopie du message de Florian53 (posté au mauvais endroit) :
Bonjour ric,
Ha oui, effectivement je n'avais pas vu, du coup il faut juste modifier le critère par "(" et mettre un len-1 pour enlever l'espace.
Merci de ta remarque ric
Bonjour à tous,
Le critère pourrait aussi être " (" > espace et parenthèse ouvrante.
Ça fonctionne sous Excel 365.
ric
Pourquoi ai je toujours des idées compliquées