recherche rapide

[christophe24]

bonjour à tous
je joint à ce post un fichier comprenant une rechercher super rapide mais basé uniquement sur la colonne a.
peut on modifier le code de façon a avoir une recherche entre A5 et V800
en vous remerciant par avance

 

[david84]

Re : recherche rapide

Bonsoir,
as-tu essayé simplement de remplacer Range("A2:A24") par Range("A5:V800") et d'inclure une 2ème boucle de recherche par colonne ?
A+

 

[david84]

Re : recherche rapide

J'utiliserai plutôt une boucle For...Each du type :

Private Sub TextBox1_Change()
Application.ScreenUpdating = False
Dim Plage As Range, c As Range
Set Plage = Range("A2:V800")
Plage.Interior.ColorIndex = 2
ListBox1.Clear
If TextBox1 <> "" Then
    For Each c In Plage
        If c.Value Like "*" & TextBox1 & "*" Then
            c.Interior.ColorIndex = 43
            ListBox1.AddItem c.Value
        End If
    Next
End If
End Sub

A+
Edit : bonsoir Jean-Marcel

 

[christophe24]

Re : recherche rapide

Bonsoir et merci pour vos réponses
je vous envoie sur une feuille adaptée à mes besoins avec un de vos codes proposés, mais cela ne passe pas .
champ de recherche toujours le même, entre A6 et V800
voilà encore désolé de ne pas avoir donné cet exemple dès le premier message.
merci de votre aide.

 

[BOISGONTIER]

Re : recherche rapide

Bonjour,

Remarques:
-Change() sur une BD importante fait patiner
-Find est plus rapide que l'exploration de chaque cellule

Private Sub B_ok_Click()
  Application.ScreenUpdating = False
  Set f = ActiveSheet
  Me.ListBox1.Clear
  Set Plage = f.[A5].CurrentRegion
  Plage.Interior.ColorIndex = 2
  Set Plage = Plage.Offset(1).Resize(Plage.Rows.Count - 1)
  Set c = Plage.Find(Me.TextBox1, , , xlPart)
  If Not c Is Nothing Then
     i = 0
     premier = c.Address
     Do
       Me.ListBox1.AddItem
       Me.ListBox1.List(i, 0) = c.Value
       Me.ListBox1.List(i, 1) = c.Row
       c.Interior.ColorIndex = 3
       i = i + 1
       Set c = Plage.FindNext(c)
     Loop While Not c Is Nothing And c.Address <> premier
  End If
End Sub

Private Sub ListBox1_Click()
   ligne = Val(ListBox1.Column(1))
   Rows(ligne).Select
End Sub

Version 2

Private Sub B_ok_Click()
  Application.ScreenUpdating = False
  Set f = ActiveSheet
  Me.ListBox1.Clear
  Set plage = f.[A5].CurrentRegion
  plage.Interior.ColorIndex = 2
  Set plage = plage.Offset(1).Resize(plage.Rows.Count - 1)
  Set c = plage.Find(Me.TextBox1, , , xlPart)
  If Not c Is Nothing Then
     i = 0
     premier = c.Address
     Do
       Me.ListBox1.AddItem
       Me.ListBox1.List(i, 0) = c.Value
       Me.ListBox1.List(i, 1) = c.Row
       c.Interior.ColorIndex = 3
       i = i + 1
       Set c = plage.FindNext(c)
     Loop While Not c Is Nothing And c.Address <> premier
  End If
End Sub

Private Sub B_tout_Click()
  Application.ScreenUpdating = False
  Set f = ActiveSheet
  Set plage = f.[A5].CurrentRegion
  plage.Rows.Hidden = False
End Sub

Private Sub ListBox1_Click()
   ligne = Val(ListBox1.Column(1))
   Rows(ligne).Select
End Sub

Private Sub B_filtre_Click()
  Application.ScreenUpdating = False
  Set f = ActiveSheet
  Set plage = f.[A5].CurrentRegion
  plage.Offset(1).Rows.Hidden = True
  n = Me.ListBox1.ListCount
  For i = 0 To n - 1
    ligne = Me.ListBox1.List(i, 1)
    ActiveSheet.Rows(ligne).Hidden = False
  Next i
End Sub

Private Sub B_copie_Click()
  Set f = ActiveSheet
  Set plage = f.[A5].CurrentRegion
  plage.SpecialCells(xlCellTypeVisible).Copy Sheets("Result").[A1]
End Sub