XL 2010 adapter une macro sur la feuille active

[arvin]

bonjour à tous, grâce au forum la macro suivante colorier un mot en fonction d'une liste (si le mot appartient à une liste alors il colorie le mot)
je souhaiterai maintenant adapter cette macro en
-prenant en compte la feuille active
- la liste est sur une autre feuille
ci joint les explications dans le code VBA du fichier
merci à tous

 

[sylvanu]

Bonjour Arvin,
Un essai en PJ avec :

Sub essai()
    Dim plage As Range, Z%, cell As Range
    Application.ScreenUpdating = False
    Set F = Sheets("test")
    For Z = 3 To 33
        For Each cell In ActiveSheet.Range("F1:K10")
            If cell.Value = F.Cells(Z, 2).Value Then cell.Interior.Color = F.Cells(Z, 2).Interior.Color
            If cell.Value = F.Cells(Z, 2).Value Then cell.Font.Color = F.Cells(Z, 2).Font.Color
        Next cell
    Next Z
End Sub

 

[soan]

Bonjour arvin, sylvanu,

je t'ai répondu ICI.

(clique sur le lien bleu)

soan

 

[job75]

Bonjour arvin, sylvanu, soan,

Puisque pour chaque mot on colore tout d'un seul coup ceci devrait être plus rapide :

Sub essai()
Dim P As Range, c As Range
Set P = Sheets("edt").[F1:K10] 'plage à adapter
Application.ScreenUpdating = False
P.Interior.ColorIndex = xlNone 'RAZ
On Error Resume Next 'si aucune SpecialCell
For Each c In Sheets("test").[B:B].SpecialCells(xlCellTypeConstants) 'colonne à adapter
    P.Replace c, "#N/A", xlWhole
    P.SpecialCells(xlCellTypeConstants, 16).Interior.Color = c.Interior.Color
    P.Replace "#N/A", c
Next
End Sub

PS : il y avait un espace superflu en H6 à droite de rené, je l'ai supprimé.

A+

 

[arvin]

un grand merci à vous tous : je penche pour la solution de sylvanu qui correspondrait le mieux
je vais étudier vos propositions
génial

 

[soan]

@arvin (bonjour job75)

sur ton autre sujet, où tu as évoqué le même problème qu'ici, tu as écrit :

« réussi ! mais je souhaite adapter la macro à la feuille active »​

---

je crois que tu as oublié de cliquer sur le lien bleu de mon post#3,​

alors je mets ici mon code VBA (non testé) :

Option Explicit

Sub essai()
  Dim cel1 As Range, cel2 As Range, Z As Byte
  Application.ScreenUpdating = 0
  For Z = 3 To 33
    Set cel1 = Cells(Z, 2)
    For Each cel2 In [F1:K10]
      If cel2 = cel1 Then
        cel2.Interior.Color = cel1.Interior.Color
        cel2.Font.Color = cel1.Font.Color
      End If
    Next cel2
  Next Z
End Sub

si tu as plus de 255 lignes, alors pour la ligne Dim, au lieu de Z As Byte
met : Z As Long ou plus simplement : Z&

soan

 

[job75]

Au post #4 je ne copiais que les couleurs de fond car c'est tout ce qu'il y avait à copier dans votre fichier.

Maintenant s'il y a en plus des couleurs de police à copier voyez ce fichier (2) :

Sub essai()
Dim P As Range, c As Range
Set P = Sheets("edt").[F1:K10] 'plage à adapter
Application.ScreenUpdating = False
P.Interior.ColorIndex = xlNone 'RAZ couleur fond
P.Font.ColorIndex = xlAutomatic 'RAZ couleur police
On Error Resume Next 'si aucune SpecialCell
For Each c In Sheets("test").[B:B].SpecialCells(xlCellTypeConstants) 'colonne à adapter
    P.Replace c, "#N/A", xlWhole
    With P.SpecialCells(xlCellTypeConstants, 16)
        .Interior.Color = c.Interior.Color
        .Font.Color = c.Font.Color
    End With
    P.Replace "#N/A", c
Next
End Sub

 

[arvin]

ok merci à, tous , je vais regarder cet AM
super le forum et merci pour vos contributions

 

[job75]

Dans le fichier joint les 3 solutions sont comparées sur la plage F1:K1000, chez moi :

- sylvanu 11,2 seconde

- soan 8,2 seconde

- job75 0,03 seconde.

 

[soan]

@job75

Dans le fichier joint les 3 solutions sont comparées sur la plage F1:K1000, chez moi :

- sylvanu 11,2 seconde

- soan 8,2 seconde

- job75 0,03 seconde.

donc le grand gagnant est :

job75, avec 0,03 seconde !

---

remarque, dans la Charte du site XLD, c'est bien précisé qu'il n'y a aucune urgence, hein ?
donc si un code VBA met plus longtemps qu'un autre à s'exécuter, c'est pas grave !

soan

 

[soan]

@job75

ben dis-donc ! tu dois avoir un super PC !

car sur le mien qui a un i5-3450 @ 3.10 GHz, une RAM 8 Go,
Windows 7, et Excel 2007, j'ai ces temps :

- sylvanu : 20,46 ; puis 20,43 secondes

- soan : 17,65 ; puis 17,32 secondes

- job75 : 75 secondes ... euh, non : 0,07 ; puis 0,04 seconde

conclusion : yeepeeeeeh ! c'est encore et toujours job75
le grand gagnant du tournoi !

soan

 

[soan]

@job75

effectivement, j'reconnais qu'tu as fait un code VBA très performant !

tu maîtrises très bien .SpecialCells(xlCellTypeConstants) !

soan