• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: Filtr v listboxu

Zaslal/a blowd 15.5.2018 9:42

Zdravím.
Narazil jsem na své limity a potřeboval bych poradit od zkušenějších.
Jde o to, jak filtrovat data, zobrazovaná v listboxu.
V příloze je userform2 - editace tras. Nad listboxem je combo box, kde potřebuji vybrat položku. V listboxu pak potřebuji zobrazit jen řádky, kde je tato položka uvedena.
Je to podstatný prvek, bez kterého je celý projekt k ničemu. V dalších formulářích pak budu potřebovat filtrovat i podle datumu - od do.

Prosím o radu jak to nejlépe vyřešit.
Napadlo mne jen toto řešení - button ve form, který spustí autofiltr v listu s daty. Po opuštění formuláře se autofiltr zruší.
Problém je, že listbox pořád zobrazuje všechny řádky z dtb, bez ohledu na autofiltr.

Tak buď poraďte, jak donutit listbox zobrazovat pouze filtrovaná data z dtb, nebo nějaký způsob, jak donutit listbox filtrovat bez použití autofiltru.

Díky

Příloha: 40380_pub_ver_0.009.zip (89kB, staženo 38x)

Zaslat odpověď >

---

blowd(15.5.2018 9:44)#040381

A sakra. Nepovolená přípona. Jsem tu nový, tak musím nejdřív přijít na to,jak sem nacpat přílohu :)citovat

elninoslov(15.5.2018 9:45)#040382

XLSM musí byť zabalené do ZIP, a nesmie prekročiť 256 KB. Ak to nestačí, použite GoogleDrive a pod...citovat

blowd(15.5.2018 9:48)#040383

Díky, už je to tam.citovat

blowd(15.5.2018 15:21)#040392

Tak jsem někde vyštrachal tento kus kódu a lehce si ho upravil:

Private Sub ComboBox8_Change()
Dim i As Long
Dim arrTrasy As Variant
With Worksheets("Trasy")
Me.ListBox1.Clear
If .Range("A" & .Rows.Count).End(xlUp).Row > 1 And Trim(Me.ComboBox8.Value) <> vbNullString Then
arrTrasy = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Value2
For i = LBound(arrTrasy) To UBound(arrTrasy)
If InStr(1, arrTrasy(i, 1), Trim(Me.ComboBox8.Value), vbTextCompare) Then
Me.ListBox1.AddItem arrTrasy(i, 1)
End If
Next i
End If
If Me.ListBox1.ListCount = 1 Then Me.ListBox1.Selected(0) = True
End With
End Sub

To by šlo, kdybych měl v listboxu jeden sloupec. Jenže já jich tam potřebuju více.
A protože tomu kódu moc nerozumím, tak nevím, jestli jde upravit, aby se v listboxu objevily další sloupce.citovat

blowd(15.5.2018 17:19)#040393

Odpovím si sám
Tohle mi funguje dokonale a v listboxu zobrazí sloupců kolik chci. Už jen dořešit vícenásobné filtrování, filtrování rozsahu, ošetřit chybové stavy a je to.

Private Sub CommandButton5_Click()

Dim rng As Range, r As Range
Worksheets("Trasy").Columns("A:Q").AutoFilter Field:=4, Criteria1:=ComboBox8.Value
lastrow = Worksheets("Trasy").Cells(1, 1).End(xlDown).Row
Set rng = Worksheets("Trasy").Range(Worksheets("Trasy").Cells(1, 1), Worksheets("Trasy").Cells(lastrow, 1))
Set rng = rng.SpecialCells(xlCellTypeVisible)
ReDim rTab(0 To rng.Count - 1, 1 To 13)
i = 0
For Each r In rng
rTab(i, 1) = r.Value
rTab(i, 2) = r.Offset(, 1)
rTab(i, 3) = r.Offset(, 2)
rTab(i, 4) = r.Offset(, 3)
rTab(i, 5) = r.Offset(, 4)
rTab(i, 6) = r.Offset(, 5)
rTab(i, 7) = r.Offset(, 6)
rTab(i, 8) = r.Offset(, 7)
rTab(i, 9) = r.Offset(, 8)
rTab(i, 10) = r.Offset(, 9)
rTab(i, 11) = r.Offset(, 10)
rTab(i, 12) = r.Offset(, 11)
rTab(i, 13) = r.Offset(, 12)
i = i + 1
Next
Me.ListBox1.List = rTab

End Subcitovat

blowd(16.5.2018 15:20)#040394

Opět zdravím a otevírám toto téma, protože to není úplně OK.
Kód výše funguje velmi dobře. Z comandbuttonu jsem ho natáhl přímo do texboxů a comboboxů, s kritérii a vše šlape bezchybně.
Jediný problém je v délce zpracování, když do kritérií zadám:
- hodnotu, která není v dtb
- hodnotu která je v dtb, ale po filtrování jiným kritériem je skrytá

Pak je hodnota lastrow příliš vysoká (1 048 576) a následné procedury trvají cca minutu.

Zkoušel jsem přidat njaké podmínky, ale rozbil jsem tím filtrování na základě více kritérií - příliš mnoho chybových stavů k ošetření.

Napadá někoho, jak to vyřešit?

Díkycitovat

blowd(16.5.2018 16:09)#040395

Tak nic, už jsem to vyřešil

lastrow = Worksheets("Trasy").UsedRange.Rows(Worksheets("Trasy").UsedRange.Rows.Count).Rowcitovat

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse