Office Guru

Userformos keresés implementálása adatbázisra, több oszlopon egyszerre

2017. december 16. - Office Guru

Egyik kedves Olvasóm kérdése volt az ötletadója ennek a posztnak, ugyanis bár ő maga már jóval túllépett az alapokon, úgy gondoltam, egy ilyen jellegű megoldás kezdetleges kialakításának bemutatása mindenki számára hasznos lehet. Adott egy adatbázis, oszlopokkal, sorokkal, mindenféle adatokkal, mint a következő példa:

listbox1.JPGEbben a posztban készíteni fogunk egy olyan userformot, amelynek a segítségével a felhasználónk roppant egyszerűen, akár már csak az első betű beírása után szűrni tud az adatbázis bármelyik oszlopában. Első lépésként a Developer ribbonfülünk Controls funkciójának Insert menüjéből szúrjunk be egy Command Buttont, amelyet aztán a jobb gombbal történt kattintás után formázzunk is meg, ahogy szeretnénk:

listbox2.JPGEzután, még mindig Design Modeban, kattintsunk duplán erre a gombra, majd a megnyíló VBA-editorban a CommandButton1 Click eseményéhez rendeljünk hozzá egy UserForm2.Show utasítást (értelemszerűen a UserForm2 helyettesítendő az adott userform nevével), azaz a gombra való kattintással elindítjuk a keresést segítő userformot.

listbox3.JPGHa már úgyis a VBA-editorban vagyunk, szépen menjünk az Insert menüpontra, ahonnan szúrjunk egy Userformot. Ha beszúrtuk, akkor a Toolbox segítségével (ha ezt nem látnánk úgy, ahogy a lenti képen, akkor a View menüben találjuk meg az indító parancsát) pakoljunk a formra legalább egy Listboxot és egy Textboxot, plusz célszerű esetleg valamiféle dizájnelemet vagy szöveget is rátenni:

listbox4.JPGAlapvetően a listboxunkat fogjuk a keresés eredményének megjelenítésére használni, a textboxban pedig gépelni fog a felhasználónk, úgyhogy a listboxot mindenképpen konfigurálnunk egy kicsit. Kattintsunk rá jobb gombbal, majd a Properties alatt formázgassuk meg, de a ColumnCount paramétert mindenképpen állítsuk annyira, ahány oszlopot akarunk kezelni:

listbox5.JPGAztán nagyjából már csak a kód van hátra a Textboxunk mögött. Kattintsunk a mezőre jobb gombbal, majd View Code menüpont segítségével menjünk át a Textboxunk Change eseményéhez:

listbox6.JPGTehát ez a kód akkor fog lefutni, ha bármi változás történik a szövegdobozunkban (ergó elkezdünk gépelni). Első lépésként töröljük ki a Listboxunk aktuális tartalmát. Az "me" parancsról már írtam itt korábban, ez mindig arra a "szülő" objektumra hivatkozik, amelyikben a kód benne van, jelen esetben tehát az "me" a userformot jelenti - azaz a userformunk Listbox1-éről beszélünk. Ezután definiáljunk egy i nevű változót, amely nagyjából a vizsgálandó sorokat jelenti, ezért lesz a következő sorunk egy For .. To..., ugyanis amennyiben elkezdünk gépelni, akkor a később következő kódrészeket meg fogjuk nézni az A oszlop összes (A:A), nem üres (CountA("A:A")) során, a headert leszámítva (For i = 2).

listbox7.JPGDe egy újabb For ciklussal kell folytatnunk, hiszen soronként mind a három oszlopot meg kell vizsgálnunk, hiszen nem tudhatjuk, hogy a felhasználó az adatbázis három oszlopa közül melyikben keresne éppen. És hogy az így kialakult mátrix elemein milyen vizsgálatot is fogunk elvégezni?

Elsőként a Length névre keresztelt változóval vetessük fel a Textboxunkba írt szöveg karakterszámát. Ezután viszont jön a tényleges vizsgálat, a kód lelke, azaz ha (If) az adott munkalapunk előbb létrehozott mátrixának (minden sor minden oszlopát vizsgáljuk) aktuálisan vizsgált cellája (.Cells(i,f)) értékének (.Value) bal oldaláról levágunk annyi karaktert (Left), amennyit a felhasználó éppen beírt a textboxba és ez a levágott rész pontosan megegyezik a textboxba beírt szöveggel (és hát persze valami van a textboxban, ergó me.textbox1.text <> ""), akkor (Then) jön a képbe a Listbox AddItem metódusa, amelynek segítségével a listboxban megjelenített értékek listájához tudunk egy újabb értéket hozzáadni. Ezzel ugyanis szépen hozzáadjuk annak a sornak az első oszlopában szereplő értéket a listboxhoz, amely sorban a fenti vizsgálat egyezést talált bármelyik oszlopban.

listbox8.JPGA kód zárórészével pedig igazából már csak az előbb AddItemmel hozzáadott, első oszlopban szereplő érték mellé kell a második és harmadik oszlopban szereplő értékeket is beraknunk a Listboxba, amit pedig egy újabb For segítségével fogunk elérni, méghozzá úgy, hogy amennyiben a fenti vizsgálat talált egy egyezést, akkor még lesz egy, két lépésből álló ciklusunk (For m = 1 to 2), amelyben a listboxunk második és harmadik oszlopába betesszük az adott sor második és harmadik oszlopában szereplő értéket. Alapvetően ez így elég egyértelmű lenne, kivéve azt a mínusz egyest a listbox List tulajdonságában (ez utóbbi egyébként egy bizonyos elemet jelent a listboxban) szereplő listbox.listcount tulajdonság mögött, ami egyébként arra használatos, hogy megtudjuk egy listbox elemeinek számát. Szóval amit tudnunk kell erről az az, a ListCount mindig eggyel kezdi a számlálást az elemeknél, viszont a listbox nullánál kezdődik, ergó ez azt jelenti, hogy

.List(ListBox1.ListCount - 1, 1)

az első sorban és második oszlopban szereplő elemet fogja jelenteni, a -1,2 pedig a harmadikat.

listbox9.JPGÉs innentől kezdve már csak a For ciklusok kötelező Next elemeit kell betennünk és lezárhatjuk a szubrutint. Íme az eredmény:

listbox10.JPG

A bejegyzés trackback címe:

https://officeguru.blog.hu/api/trackback/id/tr9113505297

Kommentek:

A hozzászólások a vonatkozó jogszabályok  értelmében felhasználói tartalomnak minősülnek, értük a szolgáltatás technikai  üzemeltetője semmilyen felelősséget nem vállal, azokat nem ellenőrzi. Kifogás esetén forduljon a blog szerkesztőjéhez. Részletek a  Felhasználási feltételekben és az adatvédelmi tájékoztatóban.

2017.12.16. 22:15:20

hát tényleg elég kezdetlegesnek tűnik, nem hinném hogy erre nincs egyszerűbb módszer (valami For ... Each jutna eszembe egyből), plusz ez (csak) balról keres

ami biztos a Length= Len( ... átrakható a Dim után egyből tekintve, hogy elég egyszer fusson változásonként

na majd karácsonyi szünetben nekiugrok megírni :)

Office Guru 2017.12.16. 22:21:49

@népszopás: Azám, kezdetleges, ez is volt a cél, de remélhetőleg valaki ezzel már neki tud indulni egy jó kis elmélkedésnek:)
Úgyhogy jöhetnek egyszerűsítő ötletek és javaslatok, a karácsonyi szünetben én meg lehet hozzádobok egy frissítést ehhez a kódhoz, hogy ne csak balról keressen.

Köszi !

GGy 2017.12.18. 08:32:32

Használd már a forráskódban TAB billentyűt is, ez így olvashatatlan!!

2017.12.28. 21:35:59

@népszopás: hát se nem szebb, se nem jobb, de megígértem:

Private Sub TextBox1_Change()
Dim tart, sor, cella As Range
Dim talalt As Boolean

Set tart = Range("A2:C10")

Me.ListBox1.Clear
Me.ListBox1.ColumnCount = 3

keres = Me.TextBox1.Text

For Each sor In tart.Rows
talalt = False
For Each cella In sor.Cells
If InStr(1, cella.Value, keres, vbTextCompare) And keres <> "" Then talalt = True
Next cella

If talalt Then
Me.ListBox1.AddItem sor.Cells(1, 1).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = sor.Cells(1, 2).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = sor.Cells(1, 3).Value
End If
Next sor

End Sub

(valami azt súgja, hogy ennél jóval egyszerűbben meg lehet írni (VBA-ban), csak még nem jutottam el oda)

ui. nem lenne szerencsésebb a példákat excelben (is ) feltölteni?

2017.12.28. 21:37:10

(a blogmotor megeszi a tabot)

Private Sub TextBox1_Change()
Dim tart, sor, cella As Range
Dim talalt As Boolean

Set tart = Range("A2:C10")

Me.ListBox1.Clear
Me.ListBox1.ColumnCount = 3

keres = Me.TextBox1.Text

For Each sor In tart.Rows
talalt = False
For Each cella In sor.Cells
If InStr(1, cella.Value, keres, vbTextCompare) And keres <> "" Then talalt = True
Next cella

If talalt Then
Me.ListBox1.AddItem sor.Cells(1, 1).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = sor.Cells(1, 2).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = sor.Cells(1, 3).Value
End If
Next sor

End Sub

2017.12.28. 21:37:47

(meg a szóközt is, na mindegy :)

2017.12.28. 22:12:03

na, csak nem hagyott nyugpdni, 1 for each-el: (de ez még mindig barkácsolás vsz.)
Private Sub TextBox1_Change()
Dim tart, cella As Range

Set tart = Range("A1:C10")

Me.ListBox1.Clear
Me.ListBox1.ColumnCount = 3

keres = Me.TextBox1.Text

For Each cella In tart.Cells
  If InStr(1, cella.Value, keres, vbTextCompare) And keres <> "" Then
   Me.ListBox1.AddItem Cells(cella.row, 1)
   Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Cells(cella.row, 2)
   Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Cells(cella.row, 3)
  End If
Next cella

End Sub

2017.12.28. 22:23:09

@népszopás: mondjuk ez meg így nem jó, mert egy sort többször is berak a listába, ha több oszlopban is megvan a keresett érték

2017.12.28. 22:38:26

@népszopás: n most már befejezem :)

Private Sub TextBox1_Change()
Dim tart, cella As Range
Dim talalt As Boolean

Set tart = Range("A1:C10") 'ebben a tartományban keres
talalt = False
Me.ListBox1.Clear
Me.ListBox1.ColumnCount = 3 '3 oszlop a listboxban

keres = Me.TextBox1.Text 'amit keres

For Each cella In tart.Cells 'összes cellán (x*y) végigmegy balról-jobbra, majd lefele
  If InStr(1, cella.Value, keres, vbTextCompare) And keres <> "" Then talalt = 1 'talált

  If cella.Column = 3 And talalt Then 'amikor adott sor utolsó oszlopában van - hogy csak egyszer legyen a listában
    Me.ListBox1.AddItem Cells(cella.row, 1) 'a cellához tartozó Excel! tábla sora, elős oszlopa (itt n = a tartomány n. sorával)
    Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Cells(cella.row, 2)
    Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Cells(cella.row, 3)
    talalt = 0 'következő találatig nem lesz új lista elem
  End If
Next cella

End Sub

2018.01.02. 21:10:12

@népszopás: hát feladom, bár meg lehet írni a range.find metódusával is, de ha ez a feladat ez tűnik a legegyszerűbbnek, hogy sor*oszlop-> cellánként végigmegy rajta
én mindenesetre így csinálnám:

Private Sub TextBox1_Change()
Dim tart As Range
Dim i, c As Integer
Dim talalt As Boolean

Set tart = Range("A1:C10")

Me.ListBox1.Clear
Me.ListBox1.ColumnCount = 3

keres = Me.TextBox1.Text

For i = 1 To tart.Rows.Count 'sorok száma a tartományban
  talalt = False
  For c = 1 To tart.Columns.Count 'oszlopok száma
    If InStr(1, tart.Cells(i, c), keres, vbTextCompare) And keres <> "" Then talalt = True
  Next c

  If talalt Then 'sor végén feltölti a talált sort
    Me.ListBox1.AddItem tart.Cells(i, 1)
    Me.ListBox1.List(ListBox1.ListCount - 1, 1) = tart.Cells(i, 2)
    Me.ListBox1.List(ListBox1.ListCount - 1, 2) = tart.Cells(i, 3)
  End If
Next i

End Sub

2018.01.03. 22:47:19

@népszopás: na csak így a szép, most már csak ezt a listbox részt kellene szebbé tenni:
...
For Each sor In tart.Rows
  If Not sor.Find(keres, LookIn:=xlValues) Is Nothing Then 'és pont elég, ha egyszer megtalálja 1 sorban
    Me.ListBox1.AddItem Cells(sor.row, 1) 'a sorhoz tartozó Excel! tábla sora, első oszlopa
    Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Cells(sor.row, 2)
    Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Cells(sor.row, 3)
  End If
Next sor
...
süti beállítások módosítása