Clever-Excel-Forum

Hallo,

(alles hier ist beispielhaft, es zählt hier nur das Prinzip)

mit folgendem kleinen Programm konstruiere ich erstmal meine Werte, die ich danach auswerten möchte.

Code:
Sub Werte_konstruieren()

Dim i%, vbVor, vbNach, vbV, vbN

vbVor = Array("Lili", "Elke", "Pit", "Gert", "Fred", "Tea")

vbNach = Array("Beck", "Lot", "Pop", "Tar", "Reck", "Stur")

'Namen nach Zufallsprinzip schreiben

For i = 1 To 100

vbV = vbVor(WorksheetFunction.RandBetween(0, 5))

vbN = vbNach(WorksheetFunction.RandBetween(0, 5))

Range("A" & i) = vbV & " " & vbN

Next

'Datum nach Zufallsprinzip schreiben

For Each Zelle In Range("a1:A" & Cells(Rows.Count, 1).End(xlUp).Row)

Zelle.Offset(0, 1) = WorksheetFunction.RandBetween(9, 13) & ".06.2017"

Next

End Sub

Ausgehend von dem jeweils aktuellen Datum möchte ich nun alle Werte kennzeichnen, die 2 oder 3 Tage zurückliegen.
Das mache ich hiermit:

Code:
Sub Tagesdifferenzen_Auswerten()

Columns(3).Clear: Columns(4).Clear

For Each Zelle In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)

If CDate(Date) - CDate(Zelle.Offset(0, 1)) = 3 Then Zelle.Offset(0, 2) = "3 Tage"

If DateDiff("d", Zelle.Offset(0, 1), CDate(Date)) = 2 Then Zelle.Offset(0, 3) = "2 Tage"

Next

End Sub

So weit so gut. Welche Alternativen zur For Each Schleife (ist mir bei großen Datenmengen zu langsam) für eine solche Auswertung gibt es?
Danke schon mal für eure Mühe und Rat im voraus.

Hallo Elke,

das sollte schneller sein:

Code:
Sub Fen()

f = Cells(1).CurrentRegion.Resize(, 4)

For i = 1 To UBound(f)

    If CDate(Date) - CDate(f(i, 2)) = 3 Then f(i, 3) = "3 Tage"

    If DateDiff("d", f(i, 2), CDate(Date)) = 2 Then f(i, 4) = "2 Tage"

Next i

Cells(1, 6).Resize(UBound(f), UBound(f, 2)) = f

End Sub

Testen: zuerst die Daten in Spalte A:B einfügen, dann meinen Code (schreibt ab Spalte 6), dann deinen Code zur Kontrolle

mfg

Hallo Elke,

auch das konstruieren kannst du mit der Nutzung eines Arrays stark beschleunigen.

Code:
Option Explicit

Sub Werte_konstruieren()

Dim i%, vbVor, vbNach, vbV, vbN, vbArr()

vbVor = Array("Lili", "Elke", "Pit", "Gert", "Fred", "Tea")

vbNach = Array("Beck", "Lot", "Pop", "Tar", "Reck", "Stur")

Const intAnz As Integer = 1000

'Namen nach Zufallsprinzip schreiben

ReDim vbArr(1 To intAnz, 1 To 2)

For i = 1 To intAnz

    vbV = vbVor(WorksheetFunction.RandBetween(0, 5))

    vbN = vbNach(WorksheetFunction.RandBetween(0, 5))

    vbArr(i, 1) = vbV & " " & vbN

    vbArr(i, 2) = CDate(WorksheetFunction.RandBetween(9, 13) & ".06.2017")

Next

Range("A1").Resize(intAnz, 2).Value = vbArr

End Sub

Sub Tagesdifferenzen_Auswerten()

Dim vbArr()

Dim intI As Integer

Dim datAkt As Date

datAkt = Date

Columns(3).Clear: Columns(4).Clear

vbArr = Range("A1").Resize(Cells(Rows.Count, 1).End(xlUp).Row, 4)

For intI = 1 To UBound(vbArr, 1)

    If datAkt - vbArr(intI, 2) = 3 Then vbArr(intI, 3) = "3 Tage"

    If datAkt - vbArr(intI, 2) = 2 Then vbArr(intI, 4) = "2 Tage"

Next intI

Range("A1").Resize(Cells(Rows.Count, 1).End(xlUp).Row, 4) = vbArr

End Sub

ps. Gibt es einen Grund, warum du das Datum beim Konstruieren als Text abgespeichert hast?

Hallo,

bitte helft mir weiter. Statt wie Fennek und Ego ein Feld zu verwenden, habe ich mir überlegt, dass es auch mit dem Autofilter gehen müßte.

Code:
Sub Datum_Filtern2()

With Sheets("Tabelle1")

'Autofilter einschalten

.Columns(2).AutoFilter Field:=1, Criteria1:=CStr(DateAdd("d", -3, Date))

'mit dem Filter gefundene Werte auswählen

.AutoFilter.Range.Resize(.AutoFilter.Range.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Select

'Ergebnisse der Auswahl kennzeichnen und in Spalte C schreiben

For Each Zelle In Selection

Zelle.Offset(0, 1) = "3 Tage"

Next

'Autofilter wieder ausschalten

.Columns(2).AutoFilter

End With

End Sub

Wie ihr anhand meines Codes sehen könnt, habe ich alle mit dem Autofilter gefundenen Werte erstmal selektiert und die selektierten Werte

dann über eine For Each - Schleife, als Ergebnis in Spalte C geschrieben.

Jetzt frage ich mich aber, welche Alternativen es gibt, die durch den Autofilter gefundenen Werte auszulesen, anstatt eine For Each - Schleife

zu verwenden?

Hallo Elke,

Sub Tagesdifferenzen_Auswerten()

 Columns("C:D") = ""

 With Range("B1").Resize(Cells(Rows.Count, 2).End(xlUp).Row)

   .Offset(, 1).Formula = "=IF(TODAY()-B1=3,""3 Tage"","""")"

   '.Offset(, 1).Value = .Offset(, 1).Value

   .Offset(, 2).Formula = "=IF(TODAY()-B1=2,""2 Tage"","""")"

   '.Offset(, 2).Value = .Offset(, 2).Value

 End With

End Sub

Gruß Uwe

Elke Boese

Fennek

Ego

Elke Boese

Kuwer