For Each + For i

[Moa]

Salut à tous !

Comment combiner une macro Contenant

For i = 1 To blabla
if bla bla

Avec For Each Cell in Selection

En fait j'ai une macro qui fonctionne très bien sur la Cellule Active.

Aussi, je voudrais l'appliquer à toute une selection.

Donc, j'ai essayé avec With Range(blabla)
For i= 1 to Blabla

Mais y'a toujours un hic.

Donc j'essaye avec For Each Cell in Selection

Mais idem y'a toujours un hic.

Soit la macro n'agit pas sur la dernière cellule selectionnée, soit elle n'agit que sur la première cellule, soit autre chose etc....

J'ai essayé en plaçant des "Exit For", mais en vain....

Je pense qu'il y a un petit détail à savoir, mais qui m'échappe.

Vos idées seront les bienvenues.

Merci d'avance

@ +

Moa

 

[@+Thierry]

Bonjour Moa, le Forum

Soit je n'ai pas bien compris ta question, soit ceci devrait faire ton bonheur...

Sub MoaForEach()
Dim Plage As Range, Cell As Range

Set Plage = Selection

For Each Cell In Selection
Cell.Interior.ColorIndex = 36
Next

End Sub


Bon Après Midi
@+Thierry

 

[Moa]

Salut Thierry !

Merci d'avoir répondu.

Mais c'est un peu plus complexe que celà.

J'ai mal formulé ma question

Ceci dit, j'ai trouvé une solution à mon problème.

Sauf que je ne sais pas pourquoi, mais je dois relancer ma macro deux fois, pour qu'elle effectue bien le travail.

Aussi pourrais-tu m'indiquer la boucle à faire pour que la macro suivante s'exécute deux fois ?

Sub SupChiffre()
For Each Cell In selection
For i = 1 To Len(Cell)
Car = Mid(Cell, i, 1)
If IsNumeric(Car) Then
Cell.Replace what:=Car, replacement:=""
End If
Next i
Next Cell
End Sub

Merci à toi

@ +

Moa

 

[Moa]

Re !

C'est bon en faisant :

Sub SupChiffre()
For Each Cell In selection
For j = 0 To 2
For i = 1 To Len(Cell)
Car = Mid(Cell, i, 1)
If IsNumeric(Car) Then
Cell.Replace what:=Car, replacement:=""
End If
Next i
Next j
Next Cell
End Sub

En fait je cherchais à incrémenter un compteur dès que la boucle était faite avec Do While, mais je n'y arrivais pas.

Et en faisant rajoutant simplement for J = 0 to 2, ça marche.

Merci à toi

@ +

Moa

 

[Sylvain]

bonjour,


n'est-il pas possible de faire : range("C2:C4").cells(i).value

mais je pense que le mot clé cell est réservé et que donc la boucle doit être

Dim toto As Range

For Each toto In Range("a1:a10")
toto.Value = 4
Next

 

[Sylvain]

je m'étais endormi sur le post

A+

 

[Myta]

Salut Moa, @Thierry,Sylvain et le Forum

En remplacant un caractere ton Mid(Cellule,I,1) point sur le caractere suivant apres ton remplacement ici le vide "".

Avec le GoTo Reprise cela devrait solutionner ton probleme

Sub SupChiffre()

Dim Car As String
Dim Cellule As Range
Dim I As Byte

For Each Cellule In Selection

Reprise:
For I = 1 To Len(Cellule)
Car = Mid(Cellule, I, 1)
If IsNumeric(Car) Then
Cellule.Replace what:=Car, replacement:=""
GoTo Reprise
End If
Next I
Next Cellule
End Sub

Mytå

 

[Moa]

Salut Myta !

Merci à toi, c'est sympa de me trouver une solution.

Mais en fait, j'ai opté pour une autre solution, toute autre.

En effet, j'ai fait la même macro, pour supprimer du texte et il se pose un véritable problème avec les caractères spéciaux tels que : ? , * , ~.

Donc, j'ai opté pour un système travaillant sur les codes Ascii.

C'est beaucoup plus précis et cela donne plus de possibilités.

L'inconvénient par contre, c'est la lenteur, en effet, je balaie la cellule en comparant les 255 caractères possibles.

Sub SupToutSaufChiffre()
Dim X As Integer
For Each Cell In selection
For X = 1 To 256
Select Case X
Case 9, 10, 13, 58 To 255, 32 To 48
If X = 42 Or X = 63 Then
Car = "~" & Chr(X) & ""
ElseIf X = 126 Then
Car = "" & Chr(X) & Chr(X) & ""
Else
Car = "" & Chr(X) & ""
End If
Cell.Replace What:=Car, Replacement:=""
End Select
Next X
Next Cell
End Sub

En fait j'avais commencé une macro travaillant sur les codes Ascii en premier, mais je n'arrivais pas à résoudre le problème des trois caractères spéciaux.

Puis cet après-midi, j'ai trouvé les bouts de code, qui me manquait, sur internet.

Car = "~" & Chr(X) & ""
Car = "" & Chr(X) & Chr(X) & ""
Car = "" & Chr(X) & ""

Honnêtement, je n'en saisi pas tous les contours, car moi je m'arrêtais à

Car= ""


Bonne soirée à toi et merci encore, je garde ton truc sous le coude.

@ +

moa

 

[Myta]

re Moa

Essaye ce bout de code :

Sub Supprimer_tout_sauf_chiffres()

Dim Car As Byte
Dim Cellule As Range
Dim I As Byte

For Each Cellule In Selection

Reprise:

For I = 1 To Len(Cellule)
Car = Asc(Mid(Cellule, I, 1))
Select Case Car
Case 0 To 47, 58 To 255
Cellule = Left(Cellule, I - 1) + Right(Cellule, Len(Cellule) - I)
GoTo Reprise
End Select
Next I

Next Cellule

End Sub


Mytå

 

[Moa]

Salut Myta !

Génial ta version, elle est beaucoup plus rapide.

Mille gros merci à toi ....!!!

Je l'ai déjà adapter pour les lettres :

Sub SupLettreMyta()
...BlaBlaBla
Case 0 To 64, 91 To 96, 123 To 255
.....BlaBlaBla
End Sub

Et encore merci

@ +

Moa

 

[Moa]

Salut Myta, salut à tous !

Il y avait une petite erreur dans ma version pour ne garder que les lettres.

En effet, il manque les lettre avec accent....Héhé....!!!

Donc, correction :

Sub GardeLettreMyta()
...BlaBlaBla
Case 0 To 64, 91 To 96, 123 To 223, 247
...BlaBlaBla
End Sub


Heureusement que je les torture dans tous les sens, mes macros....Hihihi..!!

Bonne soirée à tous !

@ +

Moa