Zoekresultaten weergeven in listbox / combobox

[Luna08]

Goedeavond,

Wellicht heeft iemand van jullie een oplossing voor het volgende:

Ik heb een formulier gemaakt waar ik gegevens in kan vullen waaronder een artikelnummer. Als ik dit nummer intik zoekt hij meteen in een werkblad naar de bijbehorende omschrijving. Deze wordt automatisch ingevuld en weggeschreven naar een bestellijst.

Nu wil ik echter de mogelijkheid creeren om indien met het artikelnummer niet weet te zoeken op omschrijving. Deze omschrijving type ik in een textbox. Graag wil ik als ik bijv zoek op lamp dat ik alle mogelijke zoekresultaten waarin lamp zit te zien krijg.
Het liefst in een listbox ofzo zodat ik deze kan selecteren en het bijbehorende artikelnummer wordt geselecteerd.

Het lukt me echter niet om een overzicht te creeren van alle mogelijke resultaten.
Dit overzicht moet dus "online' geupdate worden.
Bij het typen van elke letter moet opnieuw bekeken worden of het aantal mogelijkheden veranderd is.

Ik gebruik nu de Find functie met xlPart zodat er op gedeeltes gezocht kan worden.

Wie kan me verder helpen?
Alvast bedankt,

 

[A4A]

Beste Luna08,

Als bijlage de oplossing voor je probleem.

Ik heb zelf maar een formulier aangemaakt in het blad Formulier. In het blad Producten staan de artikelnummers en omschrijvingen.

Op het formulier staat een textbox waarin een zoekwoord kan worden opgegeven.

Als in de textbox iets wordt getypt dan wordt onderstaande code uitgevoerd.

Private Sub txtOmschrijving_Change()

Dim strZoek As String
Dim strOmschrijving As Variant

strZoek = txtOmschrijving.Value
lstOmschrijvingen.Clear

If strZoek > "" Then
    ReDim strOmschrijving(0 To Sheet2.UsedRange.Rows.Count - 1)
    
    For i = 1 To Sheet2.UsedRange.Rows.Count
        strOmschrijving(i - 1) = Sheet2.Cells(i, 2).Text
    Next i
    
    lstOmschrijvingen.List = VBA.Strings.Filter(strOmschrijving, strZoek, True)
End If

End Sub

Als eerste zet hij in een variable (strZoek) de ingetypte tekst. Daarna leegt hij de Listbox (lstOmschrijvingen), als je dit niet doet dan wordt het een hele lange lijst na een paar letters.

Dim strZoek As String
Dim strOmschrijving As Variant

strZoek = txtOmschrijving.Value
lstOmschrijvingen.Clear

Doormiddel van onderstaande regel gaat hij pas zoeken als er werkelijk wat ingevuld is in het tekstveld.

If strZoek > "" Then

Om nu te gaan zoeken in de opgegeven omschrijvingen gaan we een array van strings aanmaken (strOmschrijvingen), omdat we aan het begin nog niet wisten hoe groot deze moest worden hebben we hem als eerste als variant gedimed, nu gaan we hem redimmen als array met de juiste grootte. De grootte bepalen we door de usedrange te bekijken van het blad Produkten.

ReDim strOmschrijving(0 To Sheet2.UsedRange.Rows.Count - 1)

Om de array te vullen gaan we per regel de ingevulde omschrijving in de juiste array zetten.
Dit kan je ook laten doen bij het openen van het document, nu voert hij dit elke keer weer uit.

For i = 1 To Sheet2.UsedRange.Rows.Count
        strOmschrijving(i - 1) = Sheet2.Cells(i, 2).Text
    Next i

Daarna gaan we met een filterfunctie kijken of er een match tussen de zoekstring en de array met omschrijvingen is. Dit filter geeft een array met omschrijvingen terug die matchen, deze koppelen we gelijk aan de listbox.

lstOmschrijvingen.List = VBA.Strings.Filter(strOmschrijving, strZoek, True)

Als er nu in de listbox op een onderdeel wordt geklikt dan vult hij deze in de combobox in (de comboboxen staan gelinked aan de velden van het blad Producten).
Hij voert dan tevens de routine uit die normaal ook gebeurd als men in de combobox een omschrijving kiest.

Private Sub lstOmschrijvingen_Click()
cboOmschrijving.Value = lstOmschrijvingen.Value
Call cboOmschrijving_Click
End Sub

De onderstaande code doet niets anders dan als je een artikelnummer/omschrijving kiest in de combobox, dat hij de andere combobox met het juiste artikelnummer/omschrijving neerzet.

Private Sub cboOmschrijving_Click()
cboArtikel.ListIndex = cboOmschrijving.ListIndex
End Sub

Private Sub cboArtikel_Click()
cboOmschrijving.ListIndex = cboArtikel.ListIndex
End Sub

Mvg. René

 

[Luna08]

Beste A4A,

Hardstikke bedankt voor je hulp.
Hiermee kom ik een heel eind, echter lukt me 1 ding niet.

Graag wil ik als ik op 1 van de mogelijk zoekresultaten klik niet de omschrijving kopieren maar de waarde van een cel ernaast in dezelfde rij.

Dit krijg ik echter niet voor elkaar.

Voor het zoeken gebruik ik nu jou code:

Private Sub TB_Zoeken_Change()
Dim strZoek As String
Dim strOmschrijving As Variant
strZoek = TB_Zoeken.Value
LB_Zoek_Result.Clear
If strZoek > "" Then
    ReDim strOmschrijving(0 To Sheets("Blad2").UsedRange.Rows.Count - 1)
        For i = 1 To Sheets("Blad2").UsedRange.Rows.Count
            strOmschrijving(i - 1) = Sheets("Blad2").Cells(i, 3).Text
        Next i
    LB_Zoek_Result.List = VBA.Strings.Filter(strOmschrijving, strZoek, True)
End If

End Sub

Deze waarde moet dan in een label komen.
Echter kan ik in de regel VBA.Strings.Filter(strOmschrijving, strZoek, True) geen celverwijzing selecteren.

Heb je hier misschien ook een oplossing voor?
Alvast bedankt.

PS: Is er ook een mogelijkheid om onafhankelijk van hoofdletter te zoeken?

 

[A4A]

Ik zou het zoals hieronder doen. Dit stukje code is hetzelfde als de functie die wordt aangeroepen als je op een combobox clickt. Alleen nu gaan we eerst de waarde van de combobox verranderen van de omschrijving dan de listindex gelijkstellen. Daarna de waarde van de artikel combobox naar een cell kopieëren.

Private Sub PrintArtikel()
cboOmschrijving.Value = lstOmschrijvingen.Value
cboArtikel.ListIndex = cboOmschrijving.ListIndex
CellvoorWaarde.text = cboArtikel.value
End Sub

Je kan ook de geselcteerde omschrijving op laten zoeken in de range van omschrijvingen en daar dan de row van uitlezen. Dan de uitgelezen row gebruiken maar dan met de colomn van de cel die je wilt kopieëren. Ik kan dit helaas nu niet uitwerken, maar mocht je dat willen dan stuur je maar een mail.

Mvg. René

 

[Luna08]

Hoi,

Het 1ste gedeelte is gelukt, het hoofdletter onafhankelijk zoeken nog niet helaas.

Nu ben ik nog aan het stoeien met het volgende:
Graag wil ik een overzicht maken binnen het formulier van wat er in de 1ste 5 kolommen staat van elke (gevulde) rij.

Nu kan ik een Listbox als volgt vullen met de waarde van 1 cel:

ListBox2.AddItem Sheets("CSV_Export").Cells(Index, 1).Value

Hoe kan ik zorgen dat hij de 1ste 5 cellen weergeeeft achter elkaar en de rijen onder elkaar?

Alvast bedankt voor al je hulp

 

[A4A]

Beste Luna,

Om hoofdletter onafhankelijk te zoeken is onderstaande code voldoende±

LB_Zoek_Result.List = VBA.Strings.Filter(vba.Strings.LCase(strOmschrijving), vba.Strings.LCase(strZoek), True)

Bijgaand ook een excelbestand waarin er een lsitbox met meerdere kolommen wordt getoond.

Mvg. René

 

[Luna08]

Hoi René,

Nogmaals bedankt.

Hij geeft nu alles mooi weer in de listbox.
Hoe wordt de afstand tussen de kolommen in de listbox bepaald?
Neemt ie daar de cel waarde voor of kan je dat nog instellen?

m.b.t. het hoofd/kleine letters verhaal, als ik jou oplossing gebruik dan zoekt ie alleen nog naar kleine letters. In mijn zoekblad staan echter hoofd en kleine letters door elkaar.

Nu gebruik ik de volgende code:

If InStr(Sheets("Recepten").Cells(Index, 3), woord) Then

Ik heb gegoogled en dan kom ik steeds op "TextCompare".
Maar als ik dit invoer dan krijg ik een foutmelding.

Deze code:

If InStr(Sheets("Recepten").Cells(Index, 3), woord, vbTextCompare

Heb jij nog een idee voor me?

 

[snb]

De lijst kan eenvoudiger gevuld worden met:

Private Sub cmdVullen_Click()
  sq = Blad1.UsedRange
  With lstVul
     .List = sq
     .ColumnCount = UBound(sq, 2)
  End With
End Sub

Als je de breedte van de kolommen wil instellen kan dat met:

Private Sub cmdVullen_Click()
  sq = Blad1.UsedRange
  With lstVul
    .List = sq
    .ColumnCount = UBound(sq, 2)
    .columnwidth="60;90;60;90;120;72" 
  End With
End Sub

De zoekaktie kan in 1 VBA-regel worden uitgevoerd en hoofdletter-onafhankelijk met:

Private Sub txtOmschrijving_Change()
    lstOmschrijvingen.List = Filter(Split(LCase(Join(WorksheetFunction.Transpose(Sheet2.Columns(2).SpecialCells(xlCellTypeConstants)), "|")), "|"), LCase(txtOmschrijving.Text))
End Sub

PS. om een macro aan te roepen is Call overbodig

 

[Luna08]

Hoi,

Als ik de code

Private Sub txtOmschrijving_Change()
    lstOmschrijvingen.List = Filter(Split(LCase(Join(WorksheetFunction.Transpose(Sheet2.Columns(2).SpecialCells(xlCellTypeConstants)), "|")), "|"), LCase(txtOmschrijving.Text))
End Sub

omzet naar: (anders werkt ie niet)

Private Sub txtOmschrijving_Change()
    lstOmschrijvingen.List = Filter(Split(LCase(Join(WorksheetFunction.Transpose(Sheets("Recepten").Columns(1).SpecialCells(xlCellTypeConstants)), "|")), "|"), LCase(txtOmschrijving.Text))
End Sub

Dan kan ik bij .Columns() alleen 1 of 2 invoeren, maar ik moet in de 3e kolom kijken.
Ook "C:C" o.i.d. werkt niet. Is dit wel mogelijk met deze functie?

 

[snb]

Er is geen enkele reden waarom

Private Sub txtOmschrijving_Change()
    lstOmschrijvingen.List = Filter(Split(LCase(Join(WorksheetFunction.Transpose(Sheets("Recepten").Columns(3).SpecialCells(xlCellTypeConstants)), "|")), "|"), LCase(txtOmschrijving.Text))
End Sub

niet zou werken.
De enige reden zou kunnen zijn dat kolom 3 geen cellen met gegevens bevat, of dat de resultaten in kolom 3 het resultaat zijn van formules.