MFC Multiple

[Guillaumega]

Bonjour,

J'essaie de faire une MFC >3 avec la macro de pierrejean (font+couleur) et ça ne marche pas (il ne se passe rien quand j'active la sheet)

Private Sub Worksheet_Activate()
If flag Then Exit Sub
flag = True
Application.ScreenUpdating = False
Dim cel As Range
Dim cell As Range
Dim ad As String
Set couleurs = Sheets("MFC").Range("A8:A" & Sheets("MFC").Range("A65536").End(xlUp).Row)
derlin = Range("A65536").End(xlUp).Row
dercol = Range("IV1").End(xlUp).Column
Set tableau = Range("$A$2:" & Cells(derlin, dercol).Address)
For Each cel In tableau
 If Not IsError(cel.Value) Then
    For Each cell In couleurs
      If cell.Value = UCase(cel.Value) Then
        cell.Copy
        cel.PasteSpecial Paste:=xlFormats
      End If
    Next cell
  End If
Next cel
flag = False
Application.ScreenUpdating = True
End Sub

Est-ce que vous pourriez m'aider s'il vous plait?

J'ai posté le fichier qui pèse 100kb à Lien supprimé


Merci à vous,
Guillaume

 

[pierrejean]

Re : MFC Multiple

bonsoir Guillaume

Apres adaptation (tableau debutant en B et non en A et valeurs de même casse)

 

[Guillaumega]

Re : MFC Multiple

Bonsoir PierreJean et merci pour ta réponse.
Cela fonctionne parfaitement merci !

Saurais-tu pourquoi la macro mets plusieurs seconde appliquée sur une plage de quelques centaines de cellules? Excel recalcule quand la macro passe sur chaque cellule?

Merci !
A+
Guillaume

Edit : non en faisant une copie valeur sur le tableau cela mets le même temps. C'est donc le temps logique de la procédure

 

[BOISGONTIER]

Re : MFC Multiple

Bonsoir,


couleurs =MFC!$A$2:$A$8

Private Sub Worksheet_Activate()
  Application.ScreenUpdating = False
   For Each c In Cells.SpecialCells(xlCellTypeFormulas, 2)
    Set z = [Couleurs].Find(c.Value, LookAt:=xlWhole, LookIn:=xlValues)
    If Not z Is Nothing Then
      z.Copy
      c.PasteSpecial Paste:=xlPasteFormats
    End If
   Next c
End Sub

JB

 

[Guillaumega]

Re : MFC Multiple

Merci à vous deux pour ces deux beaux scripts !