< návrat zpět

MS Excel


Téma: Filtr v listboxu rss

Zaslal/a 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: zip40380_pub_ver_0.009.zip (89kB, staženo 6x)
Zaslat odpověď >

#040381
avatar
A sakra. Nepovolená přípona. Jsem tu nový, tak musím nejdřív přijít na to,jak sem nacpat přílohu :)citovat
#040382
elninoslov
XLSM musí byť zabalené do ZIP, a nesmie prekročiť 256 KB. Ak to nestačí, použite GoogleDrive a pod...citovat
#040383
avatar
Díky, už je to tam.citovat
#040392
avatar
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
#040393
avatar
Odpovím si sám 3
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. 10

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 Sub
citovat
#040394
avatar
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
#040395
avatar
Tak nic, už jsem to vyřešil 5

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

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura III

Oblíbený formulář Faktura byl vylepšen a rozšířen. Formulář faktura III
Více se dočtete zde.

Aktivní diskuse

Automatické filtrování

elninoslov • 21.5. 13:06

Automatické filtrování

bobika99 • 21.5. 12:15

Automatické filtrování

elninoslov • 21.5. 12:05

Automatické filtrování

bobika99 • 21.5. 10:52

Automatické filtrování

elninoslov • 21.5. 9:54

Automatické filtrování

bobika99 • 21.5. 8:51

Automatické filtrování

bobika99 • 21.5. 8:48