Optimisation code SelectionChange Résolu/Fermé

Question

Bonjour, 

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.

Kuartz · Answer

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

f894009 · Answer

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

Optimisation code SelectionChange

2 réponses

Discussions similaires