'******************************************************************************
' Modul: Modul4 / erstellt : 05.11.2014
'------------------------------------------------------------------------------
' Zweck / Inhalt :
' nur die Zeilen anzeigen lassen, die in einem bestimmten Intervall liegen
' Datum in Spalte A, Tabelle hat Überschrift
' 10000 Zufallsdaten mit Autofilter
'******************************************************************************
Option Explicit
Sub MoreQuickTest()
MoreQuickIntervallFilter "01.01.2014", "15.01.2014"
End Sub
Private Sub MoreQuickIntervallFilter(dStart As Date, dEnd As Date)
Dim lstCrit As Object, lstDates As Object
Dim dInt As Date
Dim x As Long
Dim arrdates(), arrCrit()
'chk It
If IsDate(dStart) And IsDate(dEnd) = False Then Exit Sub
If dStart > dEnd Then Exit Sub
If Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).Cells.Count < 3 Then Exit Sub
'make It
With ActiveSheet.UsedRange
.AutoFilter
End With
arrdates = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
Set lstDates = CreateObject("System.Collections.ArrayList")
For x = LBound(arrdates) To UBound(arrdates)
If lstDates.Contains(arrdates(x, 1)) = False Then _
lstDates.Add arrdates(x, 1)
Next x
Set lstCrit = CreateObject("System.Collections.ArrayList")
dInt = dStart
Do
If lstDates.Contains(dInt) = True Then
lstCrit.Add "2"
lstCrit.Add Replace(Format(dInt, "m/d/yyyy"), ".", "/")
End If
dInt = dInt + 1
Loop Until dInt = dEnd + 1
'no filter
If lstCrit.Count < 2 Then Exit Sub
arrCrit = lstCrit.toarray
'interval filter
With ActiveSheet.UsedRange
.AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=arrCrit
End With
'ready
End Sub
|