Thema Datum  Von Nutzer Rating
Antwort
05.11.2014 12:28:31 Sören
NotSolved
Blau  mit Autofilter
05.11.2014 19:47:08 Gast20664
NotSolved

Ansicht des Beitrags:
Von:
Gast20664
Datum:
05.11.2014 19:47:08
Views:
572
Rating: Antwort:
  Ja
Thema:
mit Autofilter
'******************************************************************************
' 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


 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
05.11.2014 12:28:31 Sören
NotSolved
Blau  mit Autofilter
05.11.2014 19:47:08 Gast20664
NotSolved