Besoin d'aide Optimisation VBA

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,

j'ai codé le code ci dessous qui me permet de mettre en couleur les bordures de la ligne active:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Set champ = Range("A1:Bz" & Range("TableauDeBord").Rows.Count + 1) 'Set champ = Range("A1:BZ7720")
    champ.Borders.Color = RGB(0, 0, 0)
    Cells.Borders.LineStyle = xlNone
    If Not Intersect(Target, champ) Is Nothing Then
            If Target.Count = 1 Then
                With Target.EntireRow
                    With .Borders(xlEdgeTop)
                        .Color = RGB(255, 0, 0)
                    End With
                    With .Borders(xlEdgeBottom)
                        .Color = RGB(255, 0, 0)
                    End With
                End With
            End If
        End If
End Sub

Le code fonctionne, mais celui ci est un peu lent à l'exécution.
Comme mon niveau en VBA peut être comparé à celui d'une Loutre débutante, j'en appel à votre aide pour savoir si il y à possibilité d'optimiser le code pour rendre celui ci plus efficace?

Je vous remercie d'avance pour vos réponse et l'aide apporté!

Ci dessous mon fichier
Pièce jointe 318820

bonjour
je ne comprends pas très bien pourquoi tu bordure avec la couleur noire puis xlnone

malgré tout chez moi c'est instantané
il est évident que si tu a un tableau avec des milliers de lignes sa ralenti le smilblik forcement

maintenant perso
plutôt que remettre tout ton champs en xlnone avant de mettre les bordures rouge sur la ligne sélectionnée je remettrais simplement la ligne précédemment sélectionnée en xlnone
et pour cela il faut la mémoriser ici avec oldtarget
remet ta ligne du "set champ"
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Dim oldtarget As Range' a mettre en haut de module Private Sub Worksheet_SelectionChange(ByVal Target As Range) Set champ = Range("A1:Bz" & 100) 'Set champ = Range("A1:BZ7720") 'si il y une cellule memorisée on lui enleve la bordure rouge If Not oldtarget Is Nothing Then oldtarget.EntireRow.Borders.LineStyle = xlNone If Not Intersect(Target, champ) Is Nothing Then If Target.Count = 1 Then With Target.EntireRow With .Borders(xlEdgeTop): .Color = RGB(255, 0, 0): End With With .Borders(xlEdgeBottom): .Color = RGB(255, 0, 0): End With End With End If End If Set oldtarget = Target 'on memorise celle qui vient d'etre bordurée End Sub
voila

12/10/2017, 13h41
maitrebanjo

Alors déjà, merci beaucoup pour ta réponse.

Ensuite pourquoi je bordure avec la couleur noire puis xlnone. Bah en fait aucune idée, sur le coup ça me paraissait être une bonne idée, mais non !

Et je connaissais pas oldtarget, c'est vrai que c'est beaucoup mieux avec!

En tout cas merci beaucoup pour ton aide! ça marche bien mieux!
13/10/2017, 02h55
patricktoulon

re

re
c'est normal que tu ne connaisse pas j'aurais pu l'appeler tartampion ca aurait été pareil c'est juste une variable object range globale
c'est quand même plus rapide non?
13/10/2017, 08h15
Invité
Bonjour,
Pour infos,
Un informaticien c'est un fainéant comme ceux qui utilisent les macros qu'il développe!

With permet de ne pas réécrire plusieurs fois la même chose; hors dans notre cas on saisie plus que nécessaire!
Code:

1 2 .Borders(xlEdgeTop).Color = RGB(255, 0, 0) .Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
13/10/2017, 09h02
maitrebanjo

Oui merci c'est beaucoup plus rapide ! Après comme l'ordi du bureau est une vieille carne, Je pense que ça va être compliqué de faire mieux.

Merci beaucoup pour vos réponse !