simplification de macro

[mumu]

Bonjour le forum et bonne année à toutes et tous ! 🙂

Je me creuse la tête depuis un moment pour essayer de simplifier l'écriture de ce bout de macro sans succès. En fait je vais avoir besoin de coder plusieurs centaines de code lettre en code chiffre (ici il ne s'agit que d'un petit bout).
Est-ce que c'est possible d'écrire ça de manière plus light ?

Do While ActiveCell.Value <> ""
If ActiveCell.Text Like "*BL" Or ActiveCell.Text Like "*BR" Or ActiveCell.Text Like "*CH" _
Or ActiveCell.Text Like "*CM" Or ActiveCell.Text Like "*CN" Or ActiveCell.Text Like "*DK" _
Or ActiveCell.Text Like "*DP" Or ActiveCell.Text Like "*DZ" Or ActiveCell.Text Like "*FC" _
Or ActiveCell.Text Like "*LH" Or ActiveCell.Text Like "*MX" Or ActiveCell.Text Like "*PL" _
Or ActiveCell.Text Like "*RO" Or ActiveCell.Text Like "*SB" Or ActiveCell.Text Like "*SM" _
Then ActiveCell.Offset(0, 1).Value = "7"
ActiveCell.Offset(1, 0).Select
Loop

D'avance merci !!!!!!!!

Mumu

 

[pierrejean]

Re : simplification de macro

bonjour mumu

A tester

tablo = Array("*BL", "*BR", "*CH", "*CM", "*CN", "*DK", "*DP", "*DZ", "*FC", "*LH", "*MX", "*PL", "*RO", "*SB""*SM")
Do While ActiveCell.Value <> ""
For n = LBound(tablo) To UBound(tablo)
 If ActiveCell.Text Like tablo(n) Then ActiveCell.Offset(0, 1).Value = "7"
Next n
ActiveCell.Offset(1, 0).Select
Loop

 

[jp14]

Re : simplification de macro

Bonjour
Bonjour pierrejean

La simplification n'est pas simple car les valeurs à tester sont très diverses.
Par contre on peut diminuer le temps de traitement en modifiant l'ordre des test et en regroupant les tests
exemple
trouve= false
If ActiveCell.Text Like "*B" then
If ActiveCell.Text Like "*BL" Or ActiveCell.Text Like "*BR" Or ActiveCell.Text Like "*SB" then trouve = true
end if

if trouve = false and ActiveCell.Text Like "*C" then
.....................
End if

JP

 

[Pyrof]

Re : simplification de macro

Bonjour


A tester :

if instr("*BL*BR*CH ........",ActiveCell)>0 then
action
end if

 

[job75]

Re : simplification de macro

Bonjour à tous,

De mon côté j'écrirai :

Dim suite$
----------
suite = "BL BR CH CM CN DK DP DZ FC LH MX PL RO SB SM"
Do While ActiveCell.Value <> ""
If InStr(suite, Right(ActiveCell, 2)) Then ActiveCell.Offset(0, 1).Value = "7"
ActiveCell.Offset(1, 0).Select
Loop

A+

Edit : cela suppose qu'l n'y a pas un espace dans les 2 derniers caractères de la cellule, et qu'il y a au moins 2 caractères... Sinon ajouter un test : If Len(Trim(Right(ActiveCell, 2))) > 1 And ... Then

 

[mumu]

Re : simplification de macro

Bonjour à tous,

Je vous remercie pour ces réponses, du coup j'ai le choix !!!
J'ai testé 3 suggestions :

Celles de Pierrejean et job75 me conviennent parfaitement !!

jp14, cela me paraît bien compliqué comme solution....
et pyrof, j'ai adapté ta solution :

Do While ActiveCell.Value <> ""
If InStr(1, "*BL", "*BR", "*CH", "*CM", "*CN", "*DK", "*DP", "*DZ", "*FC", "*LH", "*MX", "*PL", "*RO", "*SB", "*SM", ActiveCell) > 0 Then
ActiveCell.Offset(0, 1).Value = "7"
End If
Loop

Mais cela me met un message d'erreur de compilation.... Mais bon, ce n'est pas grave vu que j'ai quand même une solution.

Je vous remercie sincèrement pour ces réponses, vous m'avez encore enlevé une épine du pied.......

@ +

Mumu

 

[mumu]

Re : simplification de macro

Juste pour info,

Dans mon cas la meilleure solution est celle de Pierrejean car dans ma suite de code certains ont 3 lettres sans l'étoile....... du coup je ne peux plus commencer la recherche à partir du deuxième caractère.

Merci encore !

Mumu

 

[Pyrof]

Re : simplification de macro

Bonjour,

On peut palier ce problème par : Dim suite
suite = "/*BL/*BR/CHAPEAU/*CM/*CN/DK/*DP/*DZ/*FC/*LH/*MX/*PL/*RO/*SB/*SM"Do While ActiveCell.Value <> ""If InStr(suite, "/" & ActiveCell) Then ActiveCell.Offset(0, 1).Value = "7"ActiveCell.Offset(1, 0).SelectLoop


/ ou tout autre caractère

 

[pierrejean]

Re : simplification de macro

Re

@ Pyrof

L'inconvenient de l'utilisation de InStr dans ce cas est que l' * perd son sens de 'n'importe quel caractere(s)' comme interpreté par Like
Avec ta macro teste successivement ABR et *BR

 

[Pyrof]

Re : simplification de macro

Il me semble qu'ici on veuille interpréter * comme un caractère et non comme un wilcarding

On vérifie *BR et non n'importe quel caractère suivi de BR.
Enfin c'est ce que j'ai compris

 

[mumu]

Re : simplification de macro

Salut,

Je vois que mon problème fait cogiter.....
PierreJean a raison le * remplace n'importe quel caractère. C'est à dire que tout ce qui se termine par BR (ABR, CBR, DBR etc....) doit prendre la valeur 7.

 

[Pyrof]

Re : simplification de macro

Ok je n'avais pas compris comme ça

Malgré tout je préfère la version de job75 à celle de Pierre-Jean (excuse moi)

car pour chaque cellule il faut faire la boucle x fois, alors que instr est exécuté une seule fois.

Tout ceci pour un gain de temps

Bonne après-midi

 

[pierrejean]

Re : simplification de macro

@ Pyrof

Tu es tout excusé : Nous avons tous droit à nos preferences

Mais l'argument que tu invoques n'est pas vraiment le meilleur
Vois ce fichier test ou les 2 methodes sont utilisées et la difference des temps d'execution des macros test et test1

 

[mumu]

Re : simplification de macro

Je suis impressionné de voir combien cela vous passionne, c'est génial.
J'ai testé tes macros Pierrejean et tu m'as convaincu et pour consoler Pyrof, j'ai adapté la solution de job75 pour une autre partie de ma macro.

En tout cas merci pour tout à tous !!

Mumu

 

[Pyrof]

Re : simplification de macro

Dernières munissions

Dans la mesure du possile, j'évite de faire des select de cellule

les macros deviennes

Sub test_PJ2()
Columns("B:B").ClearContents
Range("A1").Select
debut = Time
tablo = Array("*BL", "*BR", "*CH", "*CM", "*CN", "*DK", "*DP", "*DZ", "*FC", "*LH", "*MX", "*PL", "*RO", "*SB", "*SM")
l = 1
Do While Cells(l, 1) <> ""
For n = LBound(tablo) To UBound(tablo)
 If ActiveCell.Text Like tablo(n) Then Cells(l, 2) = "7"
Next n
l = l + 1
Loop
Cells(6, 7) = (Time - debut)
End Sub

Sub test_Pyrof2()
Columns("B:B").ClearContents
Range("A1").Select
debut = Time
Dim suite
l = 1
suite = "BL BR CH CM CN DK DP DZ FC LH MX PL RO SB SM"
While Cells(l, 1) <> ""
If InStr(suite, Right(ActiveCell, 2)) Then Cells(l, 2) = "7"
l = l + 1
Wend
Cells(7, 7) = (Time - debut)
End Sub

les temps sont de :
avec select Pierre-Jean 0,0001157407
Pyrof 0,0000694444


sans select Pierre-Jean 0,0000694444
Pyrof 0,0000231481

Il est vrai que la différence est faible, mais j'ai des traitements qui font des accès aux base de données et là on arrive à des différences enormes

je conseille aussi
en début de macro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

et en fin de macro
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Voilà j'en ai fini

amicalement