• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Zoeken in een Listbox Eerste twee kolommen

Status
Niet open voor verdere reacties.
H

HyperXnl

Gebruiker
Lid geworden
2 apr 2016
Berichten
74
Beste Excel users,

Na een tijdje gedraaid te hebben op een voorraad systeem http://www.helpmij.nl/forum/showthread.php/926501-Zoeken-binnen-Listbox?p=6022029#post6022029)
Begint de zoekfunctie het zwaar te krijgen, inmiddels heb ik wel meer dan 900 verschillende items in de lijst staan, waar door het zoeken moeizamer gaat verlopen.
Hij zoekt momenteel in alle kolommen, is er een mogelijkheid dat hij enkel nog zoekt in de eerste twee kolommen (Omschrijving en Art. NR.)

Wellicht, en dat zou helemaal top zijn, is dat wanneer ik bijv. zoek op sokken, dat alle items met sokken oplichten/ naar boven verplaatsen (soort van filter zeg maar)

Hoor graag van jullie.

Grtz. Michael
 

Bijlagen

  • Voorraadbeheer userform.xlsm
    40 KB · Weergaven: 62
Laatst bewerkt:
Je wilt iets door ons laten testen op snelheid, (probleem met 900+) en levert vervolgens een bestand aan met zegge en schrijve 2 records. Hoe kunnen we dan controleren of er snelheidsproblemen zijn?
 
@OctaFish, ik wil best een bestand maken met 900 artikelen :D, dat is geen probleem, echter is de snelheid tot nu ook niet echt het probleem, alleen denk ik dat wanneer ik het zoekgebied maar beperk tot 2 kolommen inplaats van alle kolommen, zal dit zeker sneller werken voor mij.
 
Hierbij een probeersel (zal ook niet snel zijn verwacht ik):
 

Bijlagen

  • Voorraadbeheer userform_Gijs.xlsm
    53,9 KB · Weergaven: 86
Op de eerste twee kolommen.
Code: 
Private Sub TextBox6_Change()
 With ListBox1
       For i = 0 To .ListCount - 1
           If InStr(UCase(Join(Application.Index(.List, i + 1, Array(1, 2)), "|")), UCase(TextBox6.Text)) > 0 And Len(TextBox6) > 0 Then
                .ListIndex = i
              Exit for
             Else
              .ListIndex = -1
            End If
           Next i
  End With
End Sub
 
Laatst bewerkt:
Thanks allemaal,

Voor het gemak, en mogelijk omdat er meerdere mensen in de toekomst mee moeten werken ga ik voor de code van Gijbert1.
En wellicht als ik er aan toe kom maak ik een mix tussen de code van HSV en Gijsbert1 :D


:thumb:
 
Laatst bewerkt:
@Gijsbert1, waar haalt u de Set rng1 = Range("Total_List") vandaan ? krijg hier een error op als ik de code inlaad in me huidige sheet.
Of zijn er meer aanpassingen gedaan dan enkel bij de Private Sub TextBox6_Change().
 
Ik heb een named range gemaakt (ga naar Formules --> Namen beheren)
Dit is al dynamisch gemaakt dus je zou hem kunnen kopiëren mits je huidige database op de zelfde cel start.
 
Check helemaal gelukt. Bedankt voor het snelle antwoorden.
Zonder jullie kom ik ook nergens whahahahahaha :thumb:
 
@Gijsbert1, is het ook mogelijk om jouw filter functie in de VBA Code van HSV te verwerken.
Omdat het het bestand waar het in verwerkt wordt met een log functie werkt krijg ik het niet juist werkend, de code van HSV werkt wel alleen dan filtert hij niet....

Zit al 5 uur te puzzelen maar kom er niet uit. Krijg het bestand waar hij in moet komen niet van de server anders had ik die geplaatst.
 
Je wilt dus een filter en een zoek functie combineren?!
Ik denk dat dit niet echt mogelijk is!

Althans, ik weet het niet!
 
Alles wat je filtert kan je niet selecteren.

Houd het simpel.

Code: 
Private Sub TextBox6_Change() 
With ListBox1
  .List = Worksheets("voorraad").Cells(2, 1).CurrentRegion.Resize(, 5).Value
      For i = .ListCount - 1 To 1 Step -1
        If InStr(LCase(Join(Application.Index(.List(), i + 1, Array(1, 2)))), LCase(TextBox6.Value)) = 0 Then .RemoveItem i
      Next i
 End With
End Sub


Private Sub UserForm_Initialize()
TextBox5.Value = Format(Date, "dd/mm/yyyy")
ListBox1.List = Sheets("voorraad").Cells(2, 1).CurrentRegion.Resize(, 5).Value
 TextBox6.SetFocus
  With Sheets("Leveranciers")
    ComboBox1.List = .Range("A2").Resize(.Cells(1).CurrentRegion.Rows.Count - 1).Value
End With
End Sub


Of de snellere methode:
Code: 
Private Sub TextBox6_Change()
 With ListBox1
  sv = Sheets("voorraad").Cells(2, 1).CurrentRegion.Resize(, 5)
   If TextBox6 = "" Then
    .List = sv
   Else
  c01 = "1"
        For i = 1 To UBound(sv)
          If LCase(Left(sv(i, 1), Len(TextBox6))) Like LCase(TextBox6) Or LCase(Left(sv(i, 2), Len(TextBox6))) Like LCase(TextBox6) Then c01 = c01 & "|" & i
        Next i
    If c01 <> "1" Then .List = Application.Index(sv, Application.Transpose(Split(c01, "|")), Application.Transpose([row(1:5)]))
  End If
 End With
End Sub

Of:
Code: 
Private Sub TextBox6_Change()
 With ListBox1
  sv = Sheets("voorraad").Cells(2, 1).CurrentRegion.Resize(, 5)
  c01 = "1"
        For i = 2 To UBound(sv)
          If LCase(Left(sv(i, 1), Len(TextBox6))) Like LCase(TextBox6) Or LCase(Left(sv(i, 2), Len(TextBox6))) Like LCase(TextBox6) Then c01 = c01 & "|" & i
        Next i
    If c01 <> "1" Then
     .List = Application.Index(sv, Application.Transpose(Split(c01, "|")), Application.Transpose([row(1:5)]))
    Else
    .List = sv
   End If
 End With
End Sub
 
Laatst bewerkt:
Thanks HSV ik zal vanmiddag kijken of ik vanuit huis kan inloggen op de server om te kijken big Thanks for now.
 
Loopt idd fout bij het selecteren, Ik hou hem op jou eerdere code HSV.
Krijg er hoofdpijn van ondertussen whahahahahaha.

Thanks voor de moeite
 
Dat kan:
- veel slimmer
- veel eenvoudiger
- veel sneller

Gewijzigd:
- Userform_initialize
- Textbox6_change

- Tabvolgorde in Userform
- Tabvolgorde in Frame2

Bij een correcte opbouw van het userform is .setfocus overbodig.
Probeer de interaktie met het werkblad te beperken tot de Userform Initialize procedure.

Gebruik .xlsb in plaats van .xlsm

Voor de overige code valt er ook nog een wereld te winnen.
 

Bijlagen

  • __slimmer_Gijs_snb.xlsb
    45,7 KB · Weergaven: 92
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan