OVH Cloud OVH Cloud

Suppression caractères

11 réponses
Avatar
mcleroy
Bonjour

Comment supprimer dans une sélection de cellules
tous les caractères autres que les chiffres et les lettres?

J'ai essayé avec l'enregistreur de macros, mais c'est trop efficace
elle supprime tous les caractères!!!

Aprés quelques recherches dans Google Groups
j'ai trouvé quelques pistes (voir en fin de message) mais je n'arrive pas à
regrouper
tout cela dans une seule procédure?

Quelqu'un pourrait-il m'indiquer dans quelle direction chercher?

Les pistes en question:
Sub REMOVESPACE()
'David McRitchie 2000-02-28 excel.programming
Application.ScreenUpdating = False
Dim temp As String
Dim cell As Range
For Each cell In Selection.SpecialCells(xlCellTypeConstants, 2)
'above limits to constants which are TEXT
If InStr(1, cell.Value, " ") Then 'Insure possibility of change
temp = Trim(cell.Value)
While InStr(temp, " ") > 0
temp = Replace(temp, " ", "")
Wend
cell.Value = Trim(temp)
End If
Next
End Sub

Sub Supprime_Espaces()
Dim patente As Range
Application.ScreenUpdating = False
For Each patente In Selection
patente.Replace What:=" ", Replacement:=""
Next
End Sub

For Each Caractère In Array("/", " ", ".")
strTEL = Replace(strTEL, Caractère, "")
Next

Private Sub Command1_Click()
On Error GoTo errhandler
'Ajouter deux TextBox et un Bouton
Dim str_in, str_out As String
str_in = Text1
For i = 0 To Len(str_in) - 1
If Mid(str_in, 1 + i, 1) = "/" Or _
Mid(str_in, 1 + i, 1) = "." Or _
Mid(str_in, 1 + i, 1) = " " Then
Else
str_out = str_out & Mid(str_in, 1 + i, 1)
End If
Next i
Text2 = str_out
Exit Sub
errhandler:
Exit Sub
End Sub

MOT = "~?"

ActiveCell.Replace What:=MOT, Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False


sub xx
Selection.Replace What:="~?", Replacement:="$"
end sub

10 réponses

1 2
Avatar
sabatier
bnjour mcleroy

quelquechose dans ce genre là pourrait puet-être faire l'affaire :


Sub JteRemplaceLesCaracteresViteFait()
For Each cellule In Range("A1:A10")
For Each Caractere In Array("/", "$", ":", "?") ' ici mettre les
'caractères indésirables
Range("TEL").Replace What:Êractere, Replacement:=" "
Next Caractere
Next cellule
End Sub

HTH
jps

mcleroy a écrit:
Bonjour

Comment supprimer dans une sélection de cellules
tous les caractères autres que les chiffres et les lettres?

J'ai essayé avec l'enregistreur de macros, mais c'est trop efficace
elle supprime tous les caractères!!!

Aprés quelques recherches dans Google Groups
j'ai trouvé quelques pistes (voir en fin de message) mais je n'arrive pas à
regrouper
tout cela dans une seule procédure?

Quelqu'un pourrait-il m'indiquer dans quelle direction chercher?

Les pistes en question:
Sub REMOVESPACE()
'David McRitchie 2000-02-28 excel.programming
Application.ScreenUpdating = False
Dim temp As String
Dim cell As Range
For Each cell In Selection.SpecialCells(xlCellTypeConstants, 2)
'above limits to constants which are TEXT
If InStr(1, cell.Value, " ") Then 'Insure possibility of change
temp = Trim(cell.Value)
While InStr(temp, " ") > 0
temp = Replace(temp, " ", "")
Wend
cell.Value = Trim(temp)
End If
Next
End Sub

Sub Supprime_Espaces()
Dim patente As Range
Application.ScreenUpdating = False
For Each patente In Selection
patente.Replace What:=" ", Replacement:=""
Next
End Sub

For Each Caractère In Array("/", " ", ".")
strTEL = Replace(strTEL, Caractère, "")
Next

Private Sub Command1_Click()
On Error GoTo errhandler
'Ajouter deux TextBox et un Bouton
Dim str_in, str_out As String
str_in = Text1
For i = 0 To Len(str_in) - 1
If Mid(str_in, 1 + i, 1) = "/" Or _
Mid(str_in, 1 + i, 1) = "." Or _
Mid(str_in, 1 + i, 1) = " " Then
Else
str_out = str_out & Mid(str_in, 1 + i, 1)
End If
Next i
Text2 = str_out
Exit Sub
errhandler:
Exit Sub
End Sub

MOT = "~?"

ActiveCell.Replace What:=MOT, Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:úlse


sub xx
Selection.Replace What:="~?", Replacement:="$"
end sub





--
NB. mes admiratrices voudront bien supprimer "delaile" avant de m'écrire
en bal perso....merci

Avatar
Denis Michon
Bonjour mcleroy,


Et ceci :

à copiier dans un module standard.
Tu dois adapter le nom de la feuille et de la plage de cellules
de la procédure ou tu veux faire le ménage.

'-----------------------------
Sub SupprimerCaractères()

Dim Rg As Range, A As Integer
Set Rg = Worksheets("Feuil1").Range("A1:C25")

For a = 1 To 256
Select Case a
Case 1 To 41, 43 To 48, 58 To 64, 91 To 96
'Pour les Jokers * et ?
If a = 42 Or a = 63 Then
Mot = "~" & Chr(a) & ""
Else
Mot = " & Chr(a) & "
End If
Rg.Replace What:=Mot, Replacement:="", LookAt:=xlPart
End Select
Next
Set Rg = Nothing

End Sub
'-----------------------------


Si tu veux choisir quels sont les caractères accentués que tu désires garder...

Fais afficher les caractères Ascii des des symboles, et sélectionne tous les
caractères indésirables. Tu reportes les numéros dans la procédure du select case.
'---------------
Sub AfficherLeNuméroAsciiDesCaractères()
For a = 1 To 255
Range("A" & a) = Chr(a)
Next
'---------------


Salutations!


"mcleroy" a écrit dans le message de news:
Bonjour

Comment supprimer dans une sélection de cellules
tous les caractères autres que les chiffres et les lettres?

J'ai essayé avec l'enregistreur de macros, mais c'est trop efficace
elle supprime tous les caractères!!!

Aprés quelques recherches dans Google Groups
j'ai trouvé quelques pistes (voir en fin de message) mais je n'arrive pas à
regrouper
tout cela dans une seule procédure?

Quelqu'un pourrait-il m'indiquer dans quelle direction chercher?

Les pistes en question:
Sub REMOVESPACE()
'David McRitchie 2000-02-28 excel.programming
Application.ScreenUpdating = False
Dim temp As String
Dim cell As Range
For Each cell In Selection.SpecialCells(xlCellTypeConstants, 2)
'above limits to constants which are TEXT
If InStr(1, cell.Value, " ") Then 'Insure possibility of change
temp = Trim(cell.Value)
While InStr(temp, " ") > 0
temp = Replace(temp, " ", "")
Wend
cell.Value = Trim(temp)
End If
Next
End Sub

Sub Supprime_Espaces()
Dim patente As Range
Application.ScreenUpdating = False
For Each patente In Selection
patente.Replace What:=" ", Replacement:=""
Next
End Sub

For Each Caractère In Array("/", " ", ".")
strTEL = Replace(strTEL, Caractère, "")
Next

Private Sub Command1_Click()
On Error GoTo errhandler
'Ajouter deux TextBox et un Bouton
Dim str_in, str_out As String
str_in = Text1
For i = 0 To Len(str_in) - 1
If Mid(str_in, 1 + i, 1) = "/" Or _
Mid(str_in, 1 + i, 1) = "." Or _
Mid(str_in, 1 + i, 1) = " " Then
Else
str_out = str_out & Mid(str_in, 1 + i, 1)
End If
Next i
Text2 = str_out
Exit Sub
errhandler:
Exit Sub
End Sub

MOT = "~?"

ActiveCell.Replace What:=MOT, Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:úlse


sub xx
Selection.Replace What:="~?", Replacement:="$"
end sub
Avatar
mcleroy
Bonjour et merci de votre aide

La macro ci-dessous ne fonctionne pas
Il ne se passe rien

Je l'ai aussi modifiée comme suit, il ne se passe rien non plus
Dim A as Integer
.........
End If
Range(Selection, Selection.End(xlDown)).Select
Selection.Replace......
'Set....
Je ne comprends pas pour quoi ca ne fonctionne pas

Marc.



"Denis Michon" a écrit dans le message de
news:8%%jb.2115$
Bonjour mcleroy,


Et ceci :

à copiier dans un module standard.
Tu dois adapter le nom de la feuille et de la plage de cellules
de la procédure ou tu veux faire le ménage.

'-----------------------------
Sub SupprimerCaractères()

Dim Rg As Range, A As Integer
Set Rg = Worksheets("Feuil1").Range("A1:C25")

For a = 1 To 256
Select Case a
Case 1 To 41, 43 To 48, 58 To 64, 91 To 96
'Pour les Jokers * et ?
If a = 42 Or a = 63 Then
Mot = "~" & Chr(a) & ""
Else
Mot = " & Chr(a) & "
End If
Rg.Replace What:=Mot, Replacement:="", LookAt:=xlPart
End Select
Next
Set Rg = Nothing

End Sub
'-----------------------------


Si tu veux choisir quels sont les caractères accentués que tu désires
garder...


Fais afficher les caractères Ascii des des symboles, et sélectionne tous
les

caractères indésirables. Tu reportes les numéros dans la procédure du
select case.

'---------------
Sub AfficherLeNuméroAsciiDesCaractères()
For a = 1 To 255
Range("A" & a) = Chr(a)
Next
'---------------


Salutations!


"mcleroy" a écrit dans le message de
news:

Bonjour

Comment supprimer dans une sélection de cellules
tous les caractères autres que les chiffres et les lettres?

J'ai essayé avec l'enregistreur de macros, mais c'est trop efficace
elle supprime tous les caractères!!!

Aprés quelques recherches dans Google Groups
j'ai trouvé quelques pistes (voir en fin de message) mais je n'arrive pas
à

regrouper
tout cela dans une seule procédure?

Quelqu'un pourrait-il m'indiquer dans quelle direction chercher?

Les pistes en question:
Sub REMOVESPACE()
'David McRitchie 2000-02-28 excel.programming
Application.ScreenUpdating = False
Dim temp As String
Dim cell As Range
For Each cell In Selection.SpecialCells(xlCellTypeConstants, 2)
'above limits to constants which are TEXT
If InStr(1, cell.Value, " ") Then 'Insure possibility of change
temp = Trim(cell.Value)
While InStr(temp, " ") > 0
temp = Replace(temp, " ", "")
Wend
cell.Value = Trim(temp)
End If
Next
End Sub

Sub Supprime_Espaces()
Dim patente As Range
Application.ScreenUpdating = False
For Each patente In Selection
patente.Replace What:=" ", Replacement:=""
Next
End Sub

For Each Caractère In Array("/", " ", ".")
strTEL = Replace(strTEL, Caractère, "")
Next

Private Sub Command1_Click()
On Error GoTo errhandler
'Ajouter deux TextBox et un Bouton
Dim str_in, str_out As String
str_in = Text1
For i = 0 To Len(str_in) - 1
If Mid(str_in, 1 + i, 1) = "/" Or _
Mid(str_in, 1 + i, 1) = "." Or _
Mid(str_in, 1 + i, 1) = " " Then
Else
str_out = str_out & Mid(str_in, 1 + i, 1)
End If
Next i
Text2 = str_out
Exit Sub
errhandler:
Exit Sub
End Sub

MOT = "~?"

ActiveCell.Replace What:=MOT, Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:úlse


sub xx
Selection.Replace What:="~?", Replacement:="$"
end sub





Avatar
Denis Michon
Bonjour mcleroy,


Si préfères exécuter la macro sur une plage sélectionnée,

Modifie cette ligne de code de la procédure.
Set Rg = Worksheets("Feuil1").Range("A1:C25")

Par

Set Rg = Selection

Évidemment , la feuille où tu as fait la sélection doit être la feuille active avant d'exécuter la macro.


Salutations!




"mcleroy" a écrit dans le message de news:
Bonjour et merci de votre aide

La macro ci-dessous ne fonctionne pas
Il ne se passe rien

Je l'ai aussi modifiée comme suit, il ne se passe rien non plus
Dim A as Integer
.........
End If
Range(Selection, Selection.End(xlDown)).Select
Selection.Replace......
'Set....
Je ne comprends pas pour quoi ca ne fonctionne pas

Marc.



"Denis Michon" a écrit dans le message de
news:8%%jb.2115$
Bonjour mcleroy,


Et ceci :

à copiier dans un module standard.
Tu dois adapter le nom de la feuille et de la plage de cellules
de la procédure ou tu veux faire le ménage.

'-----------------------------
Sub SupprimerCaractères()

Dim Rg As Range, A As Integer
Set Rg = Worksheets("Feuil1").Range("A1:C25")

For a = 1 To 256
Select Case a
Case 1 To 41, 43 To 48, 58 To 64, 91 To 96
'Pour les Jokers * et ?
If a = 42 Or a = 63 Then
Mot = "~" & Chr(a) & ""
Else
Mot = " & Chr(a) & "
End If
Rg.Replace What:=Mot, Replacement:="", LookAt:=xlPart
End Select
Next
Set Rg = Nothing

End Sub
'-----------------------------


Si tu veux choisir quels sont les caractères accentués que tu désires
garder...


Fais afficher les caractères Ascii des des symboles, et sélectionne tous
les

caractères indésirables. Tu reportes les numéros dans la procédure du
select case.

'---------------
Sub AfficherLeNuméroAsciiDesCaractères()
For a = 1 To 255
Range("A" & a) = Chr(a)
Next
'---------------


Salutations!


"mcleroy" a écrit dans le message de
news:

Bonjour

Comment supprimer dans une sélection de cellules
tous les caractères autres que les chiffres et les lettres?

J'ai essayé avec l'enregistreur de macros, mais c'est trop efficace
elle supprime tous les caractères!!!

Aprés quelques recherches dans Google Groups
j'ai trouvé quelques pistes (voir en fin de message) mais je n'arrive pas
à

regrouper
tout cela dans une seule procédure?

Quelqu'un pourrait-il m'indiquer dans quelle direction chercher?

Les pistes en question:
Sub REMOVESPACE()
'David McRitchie 2000-02-28 excel.programming
Application.ScreenUpdating = False
Dim temp As String
Dim cell As Range
For Each cell In Selection.SpecialCells(xlCellTypeConstants, 2)
'above limits to constants which are TEXT
If InStr(1, cell.Value, " ") Then 'Insure possibility of change
temp = Trim(cell.Value)
While InStr(temp, " ") > 0
temp = Replace(temp, " ", "")
Wend
cell.Value = Trim(temp)
End If
Next
End Sub

Sub Supprime_Espaces()
Dim patente As Range
Application.ScreenUpdating = False
For Each patente In Selection
patente.Replace What:=" ", Replacement:=""
Next
End Sub

For Each Caractère In Array("/", " ", ".")
strTEL = Replace(strTEL, Caractère, "")
Next

Private Sub Command1_Click()
On Error GoTo errhandler
'Ajouter deux TextBox et un Bouton
Dim str_in, str_out As String
str_in = Text1
For i = 0 To Len(str_in) - 1
If Mid(str_in, 1 + i, 1) = "/" Or _
Mid(str_in, 1 + i, 1) = "." Or _
Mid(str_in, 1 + i, 1) = " " Then
Else
str_out = str_out & Mid(str_in, 1 + i, 1)
End If
Next i
Text2 = str_out
Exit Sub
errhandler:
Exit Sub
End Sub

MOT = "~?"

ActiveCell.Replace What:=MOT, Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:úlse


sub xx
Selection.Replace What:="~?", Replacement:="$"
end sub





Avatar
mcleroy
Bonjour,

Sur une plage sélectionnée ou même sur "ActiveUsed.Range"" (je sais plus
trop la syntaxe)
En tous cas, j'ai fait un copier coller de la mcro SupprimerCaractères
et quand je l'éxécute aucun caractère n'est remplacé
et Excel ne bronche pas, pas de message d'erreur.
Et je ne vois toujours pas pourquoi ça ne fonctionne pas

Précision:
En fait les conditions de la macro peuvent se résumer comme suit:
si chr(x) <> A à Z ou 0 à 9, on efface le caractère
ou alors autre solution on remplace par un espace
puis on supprime les espaces superflus.


Si préfères exécuter la macro sur une plage sélectionnée,

Modifie cette ligne de code de la procédure.
Set Rg = Worksheets("Feuil1").Range("A1:C25")

Par

Set Rg = Selection

Évidemment , la feuille où tu as fait la sélection doit être la feuille
active avant d'exécuter la macro.



Salutations!




"mcleroy" a écrit dans le message de
news:

Bonjour et merci de votre aide

La macro ci-dessous ne fonctionne pas
Il ne se passe rien

Je l'ai aussi modifiée comme suit, il ne se passe rien non plus
Dim A as Integer
.........
End If
Range(Selection, Selection.End(xlDown)).Select
Selection.Replace......
'Set....
Je ne comprends pas pour quoi ca ne fonctionne pas

Marc.



"Denis Michon" a écrit dans le message de
news:8%%jb.2115$
Bonjour mcleroy,


Et ceci :

à copiier dans un module standard.
Tu dois adapter le nom de la feuille et de la plage de cellules
de la procédure ou tu veux faire le ménage.

'-----------------------------
Sub SupprimerCaractères()

Dim Rg As Range, A As Integer
Set Rg = Worksheets("Feuil1").Range("A1:C25")

For a = 1 To 256
Select Case a
Case 1 To 41, 43 To 48, 58 To 64, 91 To 96
'Pour les Jokers * et ?
If a = 42 Or a = 63 Then
Mot = "~" & Chr(a) & ""
Else
Mot = " & Chr(a) & "
End If
Rg.Replace What:=Mot, Replacement:="", LookAt:=xlPart
End Select
Next
Set Rg = Nothing

End Sub
'-----------------------------


Si tu veux choisir quels sont les caractères accentués que tu désires
garder...


Fais afficher les caractères Ascii des des symboles, et sélectionne tous
les

caractères indésirables. Tu reportes les numéros dans la procédure du
select case.

'---------------
Sub AfficherLeNuméroAsciiDesCaractères()
For a = 1 To 255
Range("A" & a) = Chr(a)
Next
'---------------




Avatar
AV
Essaye ça :

Sub zz_GardeChiffresLettres()
For Each c In Selection
If Not IsEmpty(c) Then
For i = 1 To Len(c)
If Asc(Mid(c, i, 1)) >= 48 And Asc(Mid(c, i, 1)) <= 57 _
Or Asc(Mid(c, i, 1)) >= 65 And Asc(Mid(c, i, 1)) <= 90 _
Or Asc(Mid(c, i, 1)) >= 97 And Asc(Mid(c, i, 1)) <= 122 Then
x = x & Mid(c, i, 1)
End If
Next
c.Value = x: x = ""
End If
Next
End Sub

PS : les caractères accentués sont aussi virés
Si tel ne doit pas être le cas...fais signe !

AV
Avatar
Denis Michon
Bonjour mcleroy,


Si rien ne se passait, c'est que j'avais oublié une pair de guillemets à cette ligne de code : Mot = "" & Chr(A) & ""
de la procédure.
J'ai aussi défini avec plus de précision, la liste des caractères à vérifier. Si problème, je t'ai donné un outil pour
pouvoir le faire toi-même !

Le caractère ascii 126 représenté par le tilde(~) est problématique. Je n'en connais pas la raison.


Voici la nouvelle procédure :

'-----------------------------
Sub SupprimerCaractères()

Dim Rg As Range, A As Integer
Set Rg = Worksheets("Feuil1").Range("A1:C25")
Application.ScreenUpdating = False
For A = 1 To 256
Select Case A
Case 9, 10, 13, 32 To 48, 58 To 64, 91 To 96, 123 To 255
'Pour les Jokers * et ?
If A = 42 Or A = 63 Then
Mot = "~" & Chr(A) & ""
Else
Mot = "" & Chr(A) & ""
End If
Rg.Replace What:=Mot, Replacement:="", LookAt:=xlPart
End Select
Next
Set Rg = Nothing

End Sub
'-----------------------------


Salutations!



"mcleroy" a écrit dans le message de news:
Bonjour,

Sur une plage sélectionnée ou même sur "ActiveUsed.Range"" (je sais plus
trop la syntaxe)
En tous cas, j'ai fait un copier coller de la mcro SupprimerCaractères
et quand je l'éxécute aucun caractère n'est remplacé
et Excel ne bronche pas, pas de message d'erreur.
Et je ne vois toujours pas pourquoi ça ne fonctionne pas

Précision:
En fait les conditions de la macro peuvent se résumer comme suit:
si chr(x) <> A à Z ou 0 à 9, on efface le caractère
ou alors autre solution on remplace par un espace
puis on supprime les espaces superflus.


Si préfères exécuter la macro sur une plage sélectionnée,

Modifie cette ligne de code de la procédure.
Set Rg = Worksheets("Feuil1").Range("A1:C25")

Par

Set Rg = Selection

Évidemment , la feuille où tu as fait la sélection doit être la feuille
active avant d'exécuter la macro.



Salutations!




"mcleroy" a écrit dans le message de
news:

Bonjour et merci de votre aide

La macro ci-dessous ne fonctionne pas
Il ne se passe rien

Je l'ai aussi modifiée comme suit, il ne se passe rien non plus
Dim A as Integer
.........
End If
Range(Selection, Selection.End(xlDown)).Select
Selection.Replace......
'Set....
Je ne comprends pas pour quoi ca ne fonctionne pas

Marc.



"Denis Michon" a écrit dans le message de
news:8%%jb.2115$
Bonjour mcleroy,


Et ceci :

à copiier dans un module standard.
Tu dois adapter le nom de la feuille et de la plage de cellules
de la procédure ou tu veux faire le ménage.

'-----------------------------
Sub SupprimerCaractères()

Dim Rg As Range, A As Integer
Set Rg = Worksheets("Feuil1").Range("A1:C25")

For a = 1 To 256
Select Case a
Case 1 To 41, 43 To 48, 58 To 64, 91 To 96
'Pour les Jokers * et ?
If a = 42 Or a = 63 Then
Mot = "~" & Chr(a) & ""
Else
Mot = " & Chr(a) & "
End If
Rg.Replace What:=Mot, Replacement:="", LookAt:=xlPart
End Select
Next
Set Rg = Nothing

End Sub
'-----------------------------


Si tu veux choisir quels sont les caractères accentués que tu désires
garder...


Fais afficher les caractères Ascii des des symboles, et sélectionne tous
les

caractères indésirables. Tu reportes les numéros dans la procédure du
select case.

'---------------
Sub AfficherLeNuméroAsciiDesCaractères()
For a = 1 To 255
Range("A" & a) = Chr(a)
Next
'---------------




Avatar
Denis Michon
Une dernière pour tenir compte du caractère Tilde (~)

'-------------------------------------
Sub SupprimerCaractères()

Dim Rg As Range, A As Integer
Set Rg = Worksheets("Feuil1").Range("A1:C25")
Application.ScreenUpdating = False
For A = 1 To 256
Select Case A
Case 9, 10, 13, 32 To 48, 58 To 64, 91 To 96, 123 To 255
'Pour les Jokers * et ?
If A = 42 Or A = 63 Then
Mot = "~" & Chr(A) & ""
'Pour le caractère tilde (~)
ElseIf A = 126 Then
Mot = "" & Chr(A) & Chr(A) & ""
Else
Mot = "" & Chr(A) & ""
End If
Rg.Replace What:=Mot, Replacement:="", LookAt:=xlPart
End Select
Next
Set Rg = Nothing

End Sub
'-------------------------------------


Salutations!






"Denis Michon" a écrit dans le message de news:E3wkb.6657$
Bonjour mcleroy,


Si rien ne se passait, c'est que j'avais oublié une pair de guillemets à cette ligne de code : Mot = "" & Chr(A) & ""
de la procédure.
J'ai aussi défini avec plus de précision, la liste des caractères à vérifier. Si problème, je t'ai donné un outil pour
pouvoir le faire toi-même !

Le caractère ascii 126 représenté par le tilde(~) est problématique. Je n'en connais pas la raison.


Voici la nouvelle procédure :

'-----------------------------
Sub SupprimerCaractères()

Dim Rg As Range, A As Integer
Set Rg = Worksheets("Feuil1").Range("A1:C25")
Application.ScreenUpdating = False
For A = 1 To 256
Select Case A
Case 9, 10, 13, 32 To 48, 58 To 64, 91 To 96, 123 To 255
'Pour les Jokers * et ?
If A = 42 Or A = 63 Then
Mot = "~" & Chr(A) & ""
Else
Mot = "" & Chr(A) & ""
End If
Rg.Replace What:=Mot, Replacement:="", LookAt:=xlPart
End Select
Next
Set Rg = Nothing

End Sub
'-----------------------------


Salutations!



"mcleroy" a écrit dans le message de news:
Bonjour,

Sur une plage sélectionnée ou même sur "ActiveUsed.Range"" (je sais plus
trop la syntaxe)
En tous cas, j'ai fait un copier coller de la mcro SupprimerCaractères
et quand je l'éxécute aucun caractère n'est remplacé
et Excel ne bronche pas, pas de message d'erreur.
Et je ne vois toujours pas pourquoi ça ne fonctionne pas

Précision:
En fait les conditions de la macro peuvent se résumer comme suit:
si chr(x) <> A à Z ou 0 à 9, on efface le caractère
ou alors autre solution on remplace par un espace
puis on supprime les espaces superflus.


Si préfères exécuter la macro sur une plage sélectionnée,

Modifie cette ligne de code de la procédure.
Set Rg = Worksheets("Feuil1").Range("A1:C25")

Par

Set Rg = Selection

Évidemment , la feuille où tu as fait la sélection doit être la feuille
active avant d'exécuter la macro.



Salutations!




"mcleroy" a écrit dans le message de
news:

Bonjour et merci de votre aide

La macro ci-dessous ne fonctionne pas
Il ne se passe rien

Je l'ai aussi modifiée comme suit, il ne se passe rien non plus
Dim A as Integer
.........
End If
Range(Selection, Selection.End(xlDown)).Select
Selection.Replace......
'Set....
Je ne comprends pas pour quoi ca ne fonctionne pas

Marc.



"Denis Michon" a écrit dans le message de
news:8%%jb.2115$
Bonjour mcleroy,


Et ceci :

à copiier dans un module standard.
Tu dois adapter le nom de la feuille et de la plage de cellules
de la procédure ou tu veux faire le ménage.

'-----------------------------
Sub SupprimerCaractères()

Dim Rg As Range, A As Integer
Set Rg = Worksheets("Feuil1").Range("A1:C25")

For a = 1 To 256
Select Case a
Case 1 To 41, 43 To 48, 58 To 64, 91 To 96
'Pour les Jokers * et ?
If a = 42 Or a = 63 Then
Mot = "~" & Chr(a) & ""
Else
Mot = " & Chr(a) & "
End If
Rg.Replace What:=Mot, Replacement:="", LookAt:=xlPart
End Select
Next
Set Rg = Nothing

End Sub
'-----------------------------


Si tu veux choisir quels sont les caractères accentués que tu désires
garder...


Fais afficher les caractères Ascii des des symboles, et sélectionne tous
les

caractères indésirables. Tu reportes les numéros dans la procédure du
select case.

'---------------
Sub AfficherLeNuméroAsciiDesCaractères()
For a = 1 To 255
Range("A" & a) = Chr(a)
Next
'---------------




Avatar
marc
Bonjour

Merci de votre aide
Cela fonctionne desormais
Voila la macro telle que je l'utilise plus une autre: menage
(origine:excelabo, legerement modifiee)
Sub SupprimerCaracteres()
Dim Rg As Range, A As Integer
Application.ScreenUpdating = False
Set Rg = ActiveSheet.UsedRange
For A = 1 To 256
Select Case A
Case 9, 10, 13, 32 To 48, 58 To 64, 91 To 96, 123 To 255
'Pour les Jokers * et ?
If A = 42 Or A = 63 Then
Mot = "~" & Chr(A) & ""
Else
Mot = "" & Chr(A) & ""
End If

Rg.Replace What:=Mot, Replacement:=" ", LookAt:=xlPart
End Select
Next
Set Rg = Nothing
menage
End Sub
Sub menage()
For Each cellule In ActiveSheet.UsedRange
cellule.Value = Application.Trim(cellule.Value)
Next
End Sub

Je l'utilise pour traiter des fichiers d'adresses pouvant etre tres volumineux
(plus de mille lignes)
Y-a-t-il un moyen pour accelerer cette macro?
(Est-ce qu'un pc surpuissant augmenterait la vitesse d'execution?)

Marc.
--
Ce message a ete poste via la plateforme Web club-Internet.fr
This message has been posted by the Web platform club-Internet.fr

http://forums.club-internet.fr/
Avatar
Denis Michon
Bonjour Marc,



Essaie ceci : Cette procédure traite l'intégralité de la feuille active. Elle supprime tous les espaces à droite et à
gauche de la chaîne de caractères dans une cellule.

la valeur Ascii de " " est 32

Attention, il se glisse aussi un caractère de valeur ascii 160 qui "imite" le caractère ascii 32. Cette procédure ne
traite pas ce caractère.


'------------------------------------
Sub EnleverEspace()

Dim Tblo As Variant, Rg As Range, Are As Range

With ActiveSheet
Set Rg = .UsedRange
End With

For Each Are In Rg.Areas
Tblo = Are
For a = 1 To UBound(Tblo, 1)
For b = 1 To UBound(Tblo, 2)
Tblo(a, b) = Trim(Tblo(a, b))
Next
Next
Are = Tblo
Next

Set Rg = Nothing: Set Are = Nothing

End Sub
'------------------------------------



Salutations!





"marc" a écrit dans le message de news:

Bonjour

Merci de votre aide
Cela fonctionne desormais
Voila la macro telle que je l'utilise plus une autre: menage
(origine:excelabo, legerement modifiee)
Sub SupprimerCaracteres()
Dim Rg As Range, A As Integer
Application.ScreenUpdating = False
Set Rg = ActiveSheet.UsedRange
For A = 1 To 256
Select Case A
Case 9, 10, 13, 32 To 48, 58 To 64, 91 To 96, 123 To 255
'Pour les Jokers * et ?
If A = 42 Or A = 63 Then
Mot = "~" & Chr(A) & ""
Else
Mot = "" & Chr(A) & ""
End If

Rg.Replace What:=Mot, Replacement:=" ", LookAt:=xlPart
End Select
Next
Set Rg = Nothing
menage
End Sub
Sub menage()
For Each cellule In ActiveSheet.UsedRange
cellule.Value = Application.Trim(cellule.Value)
Next
End Sub

Je l'utilise pour traiter des fichiers d'adresses pouvant etre tres volumineux
(plus de mille lignes)
Y-a-t-il un moyen pour accelerer cette macro?
(Est-ce qu'un pc surpuissant augmenterait la vitesse d'execution?)

Marc.
--
Ce message a ete poste via la plateforme Web club-Internet.fr
This message has been posted by the Web platform club-Internet.fr

http://forums.club-internet.fr/
1 2