Hallo!
Ich kenne mich mit diesem Control leider nicht aus.
Ich vermute aber, es verfügt nicht über eine derartige
eingebaute Filter-Funktion.
Ich kann deshalb nur eine Variante anbieten, bei der
die zu filternden Einträge aus der ersten in eine zweite
Listbox übernommen werden (Man könnte diese Listbox an die
Stelle der ersten setzen und nur jeweils eine der beiden Listboxen
sichtbar machen).
'lbo: Listbox mit den zu filternden Einträgem
'ColumnIndex: Spaltenindex (ab 1), in der die zu prüfenden Werte stehen
'ColumnValue: Der Wert nach dem gesucht werden soll
'Rückgabe: Array mit den gefilterten Daten
Private Function GetMatchedEntries(ByVal lbo As MsForms.ListBox, _
ByVal ColumnIndex As Integer, _
ByVal ColumnValue As Variant) As Variant()
Dim entries() As Variant
Dim matchedindices() As Integer, matchedentries() As Variant
Dim i%, k%, l%
entries = lbo.Column
ReDim matchedindices(UBound(entries, 2))
k = -1
For i = 0 To UBound(entries, 2)
If entries(ColumnIndex - 1, i) = ColumnValue Then
k = k + 1
matchedindices(k) = i
End If
Next i
If k = -1 Then
ReDim matchedentries(0, 0)
GetMatchedEntries = matchedentries
Exit Function
End If
ReDim matchedentries(UBound(entries, 1), k) As Variant
For i = 0 To k
For l = 0 To UBound(entries, 1)
matchedentries(l, i) = entries(l, matchedindices(i))
Next l
Next i
GetMatchedEntries = matchedentries
End Function
'Übertragung der Entries in eine Listbox
Private Sub SetItems(lbo As MsForms.ListBox, entries() As Variant)
Dim i%, k%
With lbo
.Clear
.ColumnCount = UBound(entries, 1)
For i = 0 To UBound(entries, 2)
.AddItem entries(0, i)
For k = 1 To UBound(entries, 1)
On Error Resume Next
.List(.ListCount - 1, k) = entries(k, i)
Next k
Next i
End With
End Sub Anwendung:
Sei Listbox1 mit Daten gefüllt, die anhand der Einträge in der ersten
Spalte gefiltert werden sollen, wobei der gesuchte Wert in der
Textbox "txtSelect" steht:
Private Sub cmdSelect_Click()
Dim matchedentries() As Variant
matchedentries = GetMatchedEntries(ListBox1, 1, txtSelect.Text)
If UBound(matchedentries, 1) > 0 Then
SetItems ListBox2, matchedentries
Else
MsgBox "nichts gefunden"
End If
End Sub
Beitrag wurde zuletzt am 31.07.12 um 13:52:16 editiert. |