Optimiser code VBA pour MFC
Bonjour le forum
J'utilise ce code pour une MFC,mais l'attente est très longue à chaque selection de cellule.
Y a t'il un moyen d'optimiser ce code pour gagner du temps.
Merci.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Cell As Range
For Each Cell In Range("A1:AA5000")
If Cell = "RP" Then
Cell.Interior.ColorIndex = 3
ElseIf Cell = "R/N" Then
Cell.Interior.ColorIndex = 28
ElseIf Cell = "M" Then
Cell.Interior.ColorIndex = 4
ElseIf Cell = "S" Then
Cell.Interior.ColorIndex = 6
ElseIf Cell = "RU" Then
Cell.Interior.ColorIndex = 3
ElseIf Cell = "N" Then
Cell.Interior.ColorIndex = 28
Else
Cell.Interior.ColorIndex = 15
End If
Next
End Sub
doudou1960 a écrit :Bonjour le forum
J'utilise ce code pour une MFC,mais l'attente est très longue à chaque selection de cellule.
Y a t'il un moyen d'optimiser ce code pour gagner du temps.
Merci.
Bonjour,
une proposition en remplaçant l'événement worksheet_selectionchange par worksheet_change. Je fais l'hypothèse que dans ta feuille toutes les cellules ont la couleur qui correspond à leur contenu. la macro ne fera les changements de couleurs que pour les cellules dont le contenu change.
Private Sub Worksheet_Change(ByVal Target As Range)
For Each Cell In application.intersect(target,Range("A1:AA5000"))
If Cell = "RP" Then
Cell.Interior.ColorIndex = 3
ElseIf Cell = "R/N" Then
Cell.Interior.ColorIndex = 28
ElseIf Cell = "M" Then
Cell.Interior.ColorIndex = 4
ElseIf Cell = "S" Then
Cell.Interior.ColorIndex = 6
ElseIf Cell = "RU" Then
Cell.Interior.ColorIndex = 3
ElseIf Cell = "N" Then
Cell.Interior.ColorIndex = 28
Else
Cell.Interior.ColorIndex = 15
End If
Next
End SubMerci h2so4
Ca fonctionne parfaitement.
A+