Microsoft 365 [VBA] Barre de recherche dynamique - objectif : cacher les lignes hors résultat

[Sergent_Lipton]

Bonjour à tous,

Pourriez-vous m'aider a alléger le temps de recherche dans ce fichier ?
J'arrive a faire ce que je veux mais c'est 1000x trop lent, 15 secondes par caractère de recherche.

Je n'ai que 1400 lignes utilisées et ce chiffre ne s'envolera pas plus.
il y a t il une solution pour accélérer la manœuvre ?
a cause de quoi mon fichier met 15ans a effectuer cette fonction ?

Fonctions utilisée :

Option Explicit
Private Sub TextBox1_Change()
Application.ScreenUpdating = False
Filtrer
Application.ScreenUpdating = True
End Sub
Private Sub TextBox2_Change()
Application.ScreenUpdating = False
Filtrer
Application.ScreenUpdating = True
End Sub
Sub Filtrer()


Dim Criteres(1 To 2), i&, j&, derlig&, t, OK As Boolean
Dim wS As Worksheet
Set wS = ThisWorkbook.Worksheets("ECS")
derlig = wS.Cells(wS.Rows.Count, "I").End(xlUp).Row
t = Range("I7:J" & derlig)

For j = 1 To 2: Criteres(j) = Me.OLEObjects.Item("TextBox" & j).Object.Value: Next j
For j = 1 To 2: Criteres(j) = IIf(Criteres(j) = "", "*", Criteres(j)): Next
For j = 1 To 2: Criteres(j) = LCase("*" & Criteres(j) & "*"): Next j

For i = 1 To UBound(t): For j = 1 To 2: t(i, j) = Cells(5 + i, 8 + j).Text: Next j, i
For i = 1 To UBound(t)
OK = True
For j = 1 To 2: OK = OK And (LCase(t(i, j)) Like Criteres(j)): Next
Rows(5 + i).Hidden = Not OK

Next i


End Sub
Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1 = ""
End Sub
Private Sub TextBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox2 = ""
End Sub


Merci d'avance a tous

 

[Compte Supprimé 979]

Bonjour,

Effectivement, c'est ingérable, pourquoi na pas utiliser tout simplement les filtres 🤔 🙄

A+

 

[p56]

Bonjour à tous,

On peut un peu optimiser le code pour réduire un peu le temps d'attente. Ici un test avec recherche de FG ou LB =>

Le code :

Sub Filtrer(Optional b As Byte)
Dim Criteres(1 To 2), T As Variant, i As Long

    Application.ScreenUpdating = False
    For i = 1 To 2
        Criteres(i) = Me.OLEObjects.Item("TextBox" & i).Object.Value
        Criteres(i) = IIf(Criteres(i) = "", "|", LCase("*" & Criteres(i) & "*"))
    Next i
    T = Me.Range("I7:J" & Me.UsedRange.Rows.Count).Value
    For i = 2 To UBound(T)
        If Me.Rows(6 + i).RowHeight > 0 Then
            If Not (LCase(T(i, 1)) Like Criteres(1) Or LCase(T(i, 2)) Like Criteres(2)) Then
                Me.Rows(6 + i).RowHeight = 0
            End If
        End If
    Next i
    Application.ScreenUpdating = True
End Sub


Sub Raz(Optional b As Byte)
    Application.ScreenUpdating = False
    Me.Rows("6:" & Me.UsedRange.Rows.Count).RowHeight = 15
    Application.ScreenUpdating = True
End Sub

P.

 

[Sergent_Lipton]

@BrunoM45
les filtres sont longs et ce fichier est a destination d'un publique connaissant tres peu excel, le bouton de tri est tellement pas loin... une fois que ca aura été trié par qqun le fichier sera foutu...
donc je leur met une barre de recherche avec la bibliotheque.

@p56
c'est teeeellement mieux ainsi, 2 secondes pour la recherche depuis mon pc sur le fichier de base, ca reste totalement admissible comparé aux 15 sec/caractere d'avant
au final ça ressemble quasi plus au code de base XD

Merci pour ton retour