Optimisation code SelectionChange
Résolu
Kuartz
Messages postés
852
Date d'inscription
Statut
Membre
Dernière intervention
-
Kuartz Messages postés 852 Date d'inscription Statut Membre Dernière intervention -
Kuartz Messages postés 852 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
Voilà mon code :
Ce code me ralentit pas mal à chaque fois que je sélectionne une cellule sur ma feuille. Cependant, il faut que ces données soient mises à jour en permanence. Avez-vous une idée pour optimiser tout ça?
Merci d'avance.
Cordialement.
Voilà mon code :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long, DL As Long 'RECHERCHEV
DL = Range("B65536").End(xlUp).Row
For i = 13 To DL
If IsError(Application.VLookup(Range("B" & i).Value, Sheets(2).Range("A1:B20000"), 2, 0)) = True Then
Range("A" & i).Value = ""
Else: Range("A" & i).Value = Application.VLookup(Range("B" & i).Value, Sheets(2).Range("A1:B20000"), 2, 0)
End If
Next i
With Shapes("Bouton 5")
.Height = 60
.Width = 150
End With
With Shapes("Bouton 3")
.Height = 60
.Width = 150
End With
With Shapes("Bouton 1")
.Height = 60
.Width = 150
End With
End Sub
Ce code me ralentit pas mal à chaque fois que je sélectionne une cellule sur ma feuille. Cependant, il faut que ces données soient mises à jour en permanence. Avez-vous une idée pour optimiser tout ça?
Merci d'avance.
Cordialement.
2 réponses
-
J'ai déjà optimisé un peu cette partie :
If IsError(Application.VLookup(Range("B" & i).Value, Sheets(2).Range("A1:B20000"), 2, 0)) = False Then Range("A" & i).Value = Application.VLookup(Range("B" & i).Value, Sheets(2).Range("A1:B20000"), 2, 0) Else: Exit For End If -
Bonjour,
il semblerait que ce soit la colonne B qui declanche les recherche:
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim i As Long, DL As Long 'RECHERCHEV 'si pas colonne B sortie If Application.Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub DL = Range("B65536").End(xlUp).Row For i = 13 To DL If IsError(Application.VLookup(Range("B" & i).Value, Sheets(2).Range("A1:B20000"), 2, 0)) = True Then Range("A" & i).Value = "" Else Range("A" & i).Value = Application.VLookup(Range("B" & i).Value, Sheets(2).Range("A1:B20000"), 2, 0) Exit For End If Next i With Shapes("Bouton 5") .Height = 60 .Width = 150 End With With Shapes("Bouton 3") .Height = 60 .Width = 150 End With With Shapes("Bouton 1") .Height = 60 .Width = 150 End With End Sub
