[VBA] - Zoomer sur une cellule (rapidement)

Bonjour,

J'utilise ce code pour zoomer sur une cellule :

Private Sub ComboBox2_Change()
d = Me.ComboBox2.Value

Set lf = Worksheets("Listing flore")
lrlf = lf.Cells(Rows.Count, 2).End(xlUp).row

Set plg = lf.Range("B2:B" & lrlf)
    With lf
            For chk = 2 To lrlf
                Set res = plg.Find(d, LookAt:=xlWhole)
                        If Not res Is Nothing Then
                            'res.Select
                            ActiveWindow.ScrollRow = res.row
                            ActiveWindow.ScrollColumn = res.Column
                        End If
            Next chk
    End With
End Sub

Lorsque je sélectionne une valeur dans une ComBox, alors je souhaite qu'Excel zoome sur la cellule correspondante.

Sauf qu'avec des milliers de lignes, ce travail est assez fastidieux pour le logiciel. Vous pensez qu'il y a une solution plus rapide ?

Je joins un fichier fonctionnel, mais un peu lent du coup.

Bonne journée !

Bonjour,

Pour la rapidité ... il faut enlever la boucle inutile ...

Un essai ....

Private Sub ComboBox1_Change()

d = Me.ComboBox1.Value

Set lf = Worksheets("Listing flore")
lrlf = lf.Cells(Rows.Count, 2).End(xlUp).Row

Set plg = lf.Range("B2:B" & lrlf)
    With lf
'''            For chk = 2 To lrlf
                Set res = plg.Find(d, LookAt:=xlWhole)
                        If Not res Is Nothing Then
                            'res.Select
                            ActiveWindow.ScrollRow = res.Row
                            ActiveWindow.ScrollColumn = res.Column
                        End If
'''            Next chk
    End With

End Sub

ric

Bonjour,

Une proposition à étudier.

Cdlt.

Option Explicit

Dim lf As Worksheet
Dim d As String
Dim res As Range, plg As Range
Dim lastRow As Long

Private Sub ComboBox1_Change()
    d = Me.ComboBox1.Value
    Set plg = lf.Cells(2, 2).Resize(lastRow - 1)
    Set res = plg.Find(d, LookAt:=xlWhole)
    If Not res Is Nothing Then
        With ActiveWindow
            .ScrollRow = res.Row
            .ScrollColumn = res.Column
        End With
    End If
End Sub

Private Sub UserForm_Initialize()
Dim lst As Object, tbl As Variant, i As Long
    Set lf = Worksheets("Listing flore")
    Set lst = CreateObject("Scripting.Dictionary")
    With lf
        lastRow = lf.Cells(Rows.Count, 2).End(xlUp).Row
        tbl = .Cells(2, 2).Resize(lastRow - 1).Value
    End With
    For i = LBound(tbl) To UBound(tbl)
        lst(tbl(i, 1)) = ""
    Next i
    Me.ComboBox1.List = lst.keys
End Sub

Bonsoir,

Merci à vous ! C'est excellent !! Je ne pensais pas que ça puisse aller aussi vite

Grâce à toute l'aide que j'ai reçu sur le forum j'ai pu passer d'un code qui passait plusieurs heures à s'exécuter, à un code qui prend moins de 15 secondes !! C'est formidable

Tout ça concernait la création de la base de données, maintenant il reste à générer tous les tableaux d'analyse.

Bonne soirée