AW: Autofilter mit Marko auf nächsten Wert stellen
26.11.2010 13:49:57
Rudi
Hallo,
so ein Akt ist das gar nicht.
Sub prcFiltern()
Dim oFilter As Object, arrFilter, sTmp
Const lngColumn As Long = 3 'Filterspalte C
Static iCounter As Integer
Application.ScreenUpdating = False
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
'Kriterien lesen
Set oFilter = CreateObject("scripting.dictionary")
arrFilter = Range(Cells(2, lngColumn), Cells(Rows.Count, lngColumn).End(xlUp))
arrFilter = WorksheetFunction.Transpose(arrFilter)
For Each sTmp In arrFilter
oFilter(sTmp) = 0
Next
'Kriterien in Array und sortieren
arrFilter = oFilter.keys
QuickSort arrFilter
'Filtern
If iCounter > UBound(arrFilter) Then iCounter = 0
Cells.AutoFilter field:=lngColumn, Criteria1:=arrFilter(iCounter)
iCounter = iCounter + 1
End Sub
Sub QuickSort(ByRef VA_Array, Optional V_Low1, Optional V_High1)
Dim V_Low2 As Long, V_High2 As Long
Dim V_Val1, V_Val2 As Variant
If IsMissing(V_Low1) Then
V_Low1 = LBound(VA_Array, 1)
End If
If IsMissing(V_High1) Then
V_High1 = UBound(VA_Array, 1)
End If
V_Low2 = V_Low1
V_High2 = V_High1
V_Val1 = VA_Array((V_Low1 + V_High1) / 2)
While (V_Low2 V_Val1 And _
V_High2 > V_Low1)
V_High2 = V_High2 - 1
Wend
If (V_Low2 V_Low1) Then Call _
QuickSort(VA_Array, V_Low1, V_High2)
If (V_Low2
Gruß
Rudi