|
Eine der String-Funktionen, die in Visual Basic 6
hinzugekommen sind, ist die  Filter-Funktion.
Mit Hilfe dieser Funktion können Sie alle Elemente eines
String-Arrays herausfiltern, die einen anderen String enthalten oder
nicht enthalten. Die herausgefilterten Elemente werden Ihnen
ebenfalls als Array geliefert.
Diese Funktion führt eher ein Schattendasein, da sie in Ihrer
Funktionsweise doch recht eingeschränkt ist. Die reine Prüfung auf
das Enthaltensein eines Teilstrings in den Elementen ist doch recht
dürftig. Auch wenn entsprechend der InStr-Funktion
die Vergleichsmethode (CompareMethod) wählbar ist, fehlen doch
Möglichkeiten, die Position des Teilstrings näher zu bestimmen und
dergleichen mehr.
Falls Sie die Funktion für nützlich halten, aber noch mit
Visual Basic 5 arbeiten, finden Sie hier zunächst die
Ersatzfunktion Filter5. Sie übergeben Ihr das zu filternde Array
und den Teilstring. Im optionalen Parameter Include legen Sie fest,
ob die Elemente geliefert werden sollen, die den Teilstring
enthalten (= True, Voreinstellung) oder nicht
enthalten. Im ebenfalls optionalen Parameter CompareMethod legen Sie
die Vergleichsmethode fest.
Public Function Filter5(Arr As Variant, Match As String, _
Optional ByVal Include As Boolean = True, _
Optional ByVal CompareMethod As VbCompareMethod _
= vbBinaryCompare) As Variant
Dim l As Long
Dim nResultArray() As String
Dim n As Long
ReDim nResultArray(LBound(Arr) To UBound(Arr))
n = LBound(Arr)
If Include Then
For l = LBound(Arr) To UBound(Arr)
If InStr(1, Arr(l), Match, CompareMethod) Then
nResultArray(n) = Arr(l)
n = n + 1
End If
Next 'l
Else
For l = LBound(Arr) To UBound(Arr)
If InStr(1, Arr(l), Match, CompareMethod) = 0 Then
nResultArray(n) = Arr(l)
n = n + 1
End If
Next 'l
End If
ReDim Preserve nResultArray(LBound(nResultArray) To n - 1)
Filter5 = nResultArray
End Function
Interessanter wäre die auch in VB 6 nicht zur
Verfügung stehende Möglichkeit, anhand eines Suchmusters (Pattern)
anstelle eines festen Teilstrings (Match) filtern zu können - etwa
in der Art des Like-Operators
anstelle der InStr-Funktion. Die oben stehende Filter-Funktion
dahingehend umzuschreiben ist kein Problem. Die beiden Zeilen, in
denen der Vergleich stattfindet, könnten etwa so aussehen:
If Arr(l) Like Pattern Then
bzw.
If Not (Arr(l) Like Pattern) Then
Allerdings würde so die Wahlmöglichkeit der Vergleichsmethode
entfallen, da für den Like-Operator die Voreinstellung des Moduls
gilt. Wie Sie die Wahlmöglichkeit auch für den Like-Operator
erhalten können, sehen Sie in  "Like
Binary oder Text". Die Funktion FilterLikeArray
gleicht der ursprünglichen Filter-Funktion, abgesehen davon, dass
der Parameter Match nun passender Pattern heißt.
Public Function FilterLikeArray(Arr As Variant, Pattern As String, _
Optional ByVal Include As Boolean = True, _
Optional ByVal CompareMethod As VbCompareMethod _
= vbBinaryCompare) As Variant
Dim l As Long
Dim nResultArray() As String
Dim n As Long
ReDim nResultArray(LBound(Arr) To UBound(Arr))
n = LBound(Arr)
If Include Then
For l = LBound(Arr) To UBound(Arr)
If LikeComp(Arr(l), Pattern, CompareMethod) Then
nResultArray(n) = Arr(l)
n = n + 1
End If
Next 'l
Else
For l = LBound(Arr) To UBound(Arr)
If Not LikeComp(Arr(l), Pattern, CompareMethod) Then
nResultArray(n) = Arr(l)
n = n + 1
End If
Next 'l
End If
ReDim Preserve nResultArray(LBound(nResultArray) To n - 1)
FilterLikeArray = nResultArray
End Function
Wenn Sie jedoch lieber mit Collections statt Arrays arbeiten,
oder wenn Sie etwa die Nodes-Collection eines
TreeView-Steuerelements oder die ListItems-Collection eines
ListView-Steuerelements filtern möchten, wäre es nicht sonderlich
sinnvoll, diese erst in ein Array zu überführen und dann zu
filtern. Nach dem Prinzip der oben stehenden Funktionen können Sie
leicht sowohl die entsprechende InStr-Variante als auch die
Like-Variante für beliebige Collections erstellen. Vorausgesetzt
ist natürlich, dass die zu übergebende Collection entweder nur
String-Elemente bzw. in Strings konvertierbare Elemente enthält (so
können Sie auch Zahlen oder Datumswerte übergeben und filtern),
oder Objekte, die über eine als String interpretierbare
Standard-Eigenschaft verfügen.
Public Function FilterColl(Collection As Object, Match As String, _
Optional ByVal Include As Boolean = True, _
Optional ByVal CompareMethod As VbCompareMethod _
= vbBinaryCompare) As Collection
Dim l As Long
Dim nResultColl As Collection
Set nResultColl = New Collection
With nResultColl
If Include Then
For l = 1 To Collection.Count
If InStr(1, CStr(Collection(l)), Match, CompareMethod) Then
.Add Collection(l)
End If
Next 'l
Else
For l = 1 To Collection.Count
If InStr(1, CStr(Collection(l)), Match, CompareMethod) _
= 0 Then
.Add Collection(l)
End If
Next 'l
End If
End With
Set FilterColl = nResultColl
End Function
Public Function FilterLikeColl(Collection As Object, _
Pattern As String, Optional ByVal Include As Boolean = True, _
Optional ByVal CompareMethod As VbCompareMethod _
= vbBinaryCompare) As Collection
Dim l As Long
Dim nResultColl As Collection
Set nResultColl = New Collection
With nResultColl
If Include Then
For l = 1 To Collection.Count
If LikeComp(CStr(Collection(l)), Pattern, _
CompareMethod) Then
.Add Collection(l)
End If
Next 'l
Else
For l = 1 To Collection.Count
If Not LikeComp(CStr(Collection(l)), Pattern, _
CompareMethod) Then
.Add Collection(l)
End If
Next 'l
End If
End With
Set FilterLikeColl = nResultColl
End Function
Leider sind ListBoxen und ComboBoxen noch so
"altmodisch", dass deren Elemente nicht in Form einer
Collection zugänglich sind. Für beide (und andere Steuerelemente
mit ähnlichen Elementlisten) brauchen Sie daher daher
spezialisierte Varianten. Hier sehen Sie exemplarisch die beiden
Varianten FilterComboBoxToArray und FilterLikeComboBoxToColl - die
übrigen Varianten FilterLikeComboBoxToArray und
FilterComboBoxToColl sind selbstverständlich im zu diesem Artikel
herunterladbaren Modul enthalten.
Public Function FilterComboBoxToArray(ComboBox As ComboBox, _
Match As String, Optional ByVal Include As Boolean = True, _
Optional ByVal CompareMethod As VbCompareMethod _
= vbBinaryCompare) As Variant
Dim l As Long
Dim nResultArray() As String
Dim n As Long
With ComboBox
ReDim nResultArray(0 To .ListCount - 1)
If Include Then
For l = 0 To .ListCount - 1
If InStr(1, .List(l), Match, CompareMethod) Then
nResultArray(n) = .List(l)
n = n + 1
End If
Next 'l
Else
For l = 1 To Collection.Count
If InStr(1, .List(l), Match, CompareMethod) = 0 Then
nResultArray(n) = .List(l)
n = n + 1
End If
Next 'l
End If
End With
ReDim Preserve nResultArray(LBound(nResultArray) To n - 1)
FilterComboBoxToArray = nResultArray
End Function
Public Function FilterLikeComboBoxToColl(ComboBox As ComboBox, _
Pattern As String, Optional ByVal Include As Boolean = True, _
Optional ByVal CompareMethod As VbCompareMethod _
= vbBinaryCompare) As Collection
Dim l As Long
Dim nResultColl As Collection
Set nResultColl = New Collection
With ComboBox
If Include Then
For l = 0 To .ListCount - 1
If LikeComp(.List(l), Pattern, CompareMethod) Then
nResultColl.Add .List(l)
End If
Next 'l
Else
For l = 1 To Collection.Count
If Not LikeComp(.List(l), Pattern, CompareMethod) Then
nResultColl.Add .List(l)
End If
Next 'l
End If
End With
Set FilterLikeComboBoxToColl = nResultColl
End Function
Da wir nun schon einmal beim Spezialisieren sind, bietet sich ein
weiterer Einsatzbereich für Filter dieser Art an: das gefilterte
Einlesen der Zeilen aus einer Datei. Hier sehen Sie die Funktionen
FilterLikeFileToArray und FilterFileToColl, die Varianten
FilterFileToArray und FilterLikeFileToColl nach dem nun bereits
bekannten Grundschema finden Sie natürlich auch im Modul.
Public Function FilterLikeFileToArray(File As String, _
Pattern As String, Optional ByVal Include As Boolean = True, _
Optional ByVal CompareMethod As VbCompareMethod _
= vbBinaryCompare) As Variant
Dim nFNr As Integer
Dim l As Long
Dim nResultArray() As String
Dim n As Long
Dim nLine As String
nFNr = FreeFile
Open File For Input Access Read Lock Read As #nFNr
ReDim nResultArray(0 To LOF(nFNr) \ 250)
If Include Then
Do While Not EOF(nFNr)
Line Input #nFNr, nLine
If LikeComp(nLine, Pattern, CompareMethod) Then
If n > UBound(nResultArray) Then
ReDim Preserve nResultArray(0 To n + 50)
End If
nResultArray(n) = nLine
n = n + 1
End If
Loop
Else
Do While Not EOF(nFNr)
Line Input #nFNr, nLine
If Not LikeComp(nLine, Pattern, CompareMethod) Then
If n > UBound(nResultArray) Then
ReDim Preserve nResultArray(0 To n + 50)
End If
nResultArray(n) = nLine
n = n + 1
End If
Loop
End If
Close #nFNr
ReDim Preserve nResultArray(LBound(nResultArray) To n - 1)
FilterLikeFileToArray = nResultArray
End Function
Public Function FilterFileToColl(File As String, Match As String, _
Optional ByVal Include As Boolean = True, _
Optional ByVal CompareMethod As VbCompareMethod _
= vbBinaryCompare) As Collection
Dim nFNr As Integer
Dim l As Long
Dim nResultColl As Collection
Dim nLine As String
Set nResultColl = New Collection
Open File For Input Access Read Lock Read As nFNr
If Include Then
Do While Not EOF(nFNr)
Line Input #nFNr, nLine
If InStr(1, nLine, Pattern, CompareMethod) Then
nResultColl.Add nLine
End If
Loop
Else
Do While Not EOF(nFNr)
Line Input #nFNr, nLine
If InStr(1, nLine, Pattern, CompareMethod) = 0 Then
nResultColl.Add nLine
End If
Loop
End If
Close #nFNr
Set FilterFileToColl = nResultColl
End Function
Sollten Sie noch weitere Filter-Varianten benötigen, dürfte es
Ihnen nun anhand dieser Beispiele nicht schwer fallen, entsprechende
Varianten selbst zu erstellen.
|