AW: VBA Autofilter Index auslesen
Kurt
Hallo Leute,
habe da was gefunden.
Option Explicit
Sub FilterFinden()
Dim i As Long, u As Long, z As Integer, t As Integer, r As Integer
Dim str_ausgabe As String
Dim ws As Worksheet
Dim FeldArray()
Set ws = Worksheets(1)
'Prüfen, ob überhaupt ein Autofilter gesetzt ist
If ws.AutoFilterMode = True Then
Else
MsgBox "Kein AutoFilter gefunden!", vbInformation, "Achtung"
Exit Sub
End If
'Der Array wird für die Datenaufnahme vorbereitet. Die Größe ergiebt sich aus dem Bereich
'(columns und rows) des Auofilter's
ReDim Preserve FeldArray(ws.AutoFilter.Range.Rows.Count, ws.AutoFilter.Range.Columns.Count)
'Variable u beinhaltet die Anzahl der Spalten des Autofilterbereiches
For u = 1 To ws.AutoFilter.Range.Columns.Count
r = 1
'Variable i beinhaltet die Anzahl der Reihen des Autofilterbereiches
For i = 1 To ws.AutoFilter.Range.Rows.Count
'Der erste Spaltenwert eines Filters wird ohne Prüfung in den Array eingetrage,
'da dieser noch nicht Doppelte sein kann
If i = 1 Then
FeldArray(i, u) = ws.AutoFilter.Range.Cells(i, u)
Else
For z = 1 To i - 1
'Nun wird die aktuelle zelle des Autofilterbereiches mit den schon im Array eingetragenen Werten verglichen
'Ist er gleich, so wird die Sprungmarke weiter angesteuert
'ist er nicht gleich, so wird der Array um diesen Datensatz erweitert
If ws.AutoFilter.Range.Cells(i, u) = FeldArray(z, u) Then
GoTo Weiter
End If
Next z
r = r + 1
'array wird erweitert
FeldArray(r, u) = ws.AutoFilter.Range.Cells(i, u)
Weiter:
End If 'i=then
Next i
Next u
'Die Daten werden in einen String gepackt und in einer MsgBox angezeigt
For i = 1 To ws.AutoFilter.Range.Columns.Count
str_ausgabe = str_ausgabe & Chr(13) & i & "Spalte:"
For u = 1 To ws.AutoFilter.Range.Rows.Count
str_ausgabe = str_ausgabe & " " & FeldArray(u, i)
Next u
Next i
MsgBox str_ausgabe, vbInformation, "Autofilterergebnisse"
End Sub
...nd Tschüss Kurt