schneller löschen?

Guten Morgen!
Heute geht es darum, dass aus importierten Daten je nach Wunsch die nicht erwünschten rausgeschmissen werden.
Es wird ein Start- und ein Enddatum über eine InputBox in Variablen geschrieben (StartDatum und EndDatum).
In Spalte E steht das Datum und in Spalte F die Uhrzeit!
EIN (Arbeits-)Tag besteht aus 3 Schichten.
Die Frühschicht von 06:00 - 13:59 Uhr
Die Spätschicht von 14:00 - 21:59 Uhr
Die Nachtschicht von 22:00 - 05:59 Uhr
Jetzt wird Zeile für Zeile in einer Schleife erst geprüft, ob der Wert in der Datumsspalte älter als das eingegebene Startdatum
oder
2 Tage weiter als das gewünschte Enddatum ist. (2 Tage, weil die Nachtschicht des Enddatums ja datumtechnisch 1 Tag weiter geht als das eingegebene Enddatum)
Im 2. Schritt werden vom ersten Tag alle Daten vor 06:00:00 Uhr entfernt (mittels >0,25)
und im 3. Schritt alle Daten vom Tag nach dem eingegebenen EndDatum ab 06:00 Uhr (mittels >=0,25)


'Zeilen zählen
Zeilenzahl = .Range("B1").CurrentRegion.Rows.Count
'Zielbereich festlegen
For j = 2 To Zeilenzahl
'Datum außerhalb Einträge entfernen
If .Range("E" & j).Value  EndDatum + 1 Then
.Rows(j).Delete
j = j - 1
'Einträge vor der ersten Frühschicht entfernen
ElseIf .Range("E" & j).Value = StartDatum And .Range("F" & j).Value = 0.25 Then
.Rows(j).Delete
j = j - 1
End If
Next j

Datenansicht:
Hilfstabelle

	A	B	C	D	E	F
1	Barcode	Masterbarcode	Schicht	LP Nutzen	Datum	Uhrzeit
2	3420	3420153123	NS	6	12.03.2018	05:58:06
3	3420	3420153119	NS	6	12.03.2018	05:59:01
4	3420	3420153101	FS	6	12.03.2018	06:01:53
5	3420	3420153095	FS	6	12.03.2018	06:02:52
6	5640	5640044145	FS	6	12.03.2018	13:58:48
7	5640	5640044151	FS	6	12.03.2018	13:59:48
8	5640	5640044169	SS	6	12.03.2018	14:01:47
9	5640	5640044193	SS	6	12.03.2018	14:02:45
10	4072	4072252078	SS	2	12.03.2018	21:59:20
11	4072	4072252222	SS	2	12.03.2018	21:59:44
12	4072	4072252294	NS	2	12.03.2018	22:07:16
13	4072	4072252298	NS	2	12.03.2018	22:07:47
14	3430	3430154057	NS	6	13.03.2018	05:58:48
15	3430	3430154051	NS	6	13.03.2018	05:59:44
16	3430	3430154752	FS	6	13.03.2018	06:04:01
17	3430	3430154746	FS	6	13.03.2018	06:05:26

Der Vorgang braucht definitiv zu lange, und ich weiß nich warum. Sollte eigentlich schnell gehen, oder?
Sind For-Schleifen grundsätzlich langsam?
Freundliche Grüße

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Dim rngDel As Range 'Zeilen zählen Zeilenzahl = .Range("B1").CurrentRegion.Rows.Count 'Zielbereich festlegen For j = 2 To Zeilenzahl 'Datum außerhalb Einträge entfernen If .Cells(j, 5).Value EndDatum + 1 Then If rngDel Is Nothing Then Set rngDel = .Rows(j) Else Set rngDel = Union(rngDel, .Rows(j)) End If 'Einträge vor der ersten Frühschicht entfernen ElseIf .Cells(j, 5).Value = StartDatum And .Cells(j, 6).Value = 0.25 Then If rngDel Is Nothing Then Set rngDel = .Rows(j) Else Set rngDel = Union(rngDel, .Rows(j)) End If End If Next j If Not rngDel Is Nothing Then rngDel.Delete

Option Explicit Sub a() Test (Date + 5), (Date + 15) End Sub Sub Test(ByVal StartDatum As Date, ByVal EndDatum As Date) Dim vData As Variant Dim indizes() As Long Dim i As Long Dim j As Long Dim t As Double t = Timer_.MicroTimer With Me i = .Range("B1").CurrentRegion.Rows.Count vData = .Range(.Cells(1, 5), .Cells(i, 6)).Value i = 0 For j = UBound(vData, 1) To LBound(vData, 1) Step -1 If vData(j, 1) EndDatum + 1 Then ReDim Preserve indizes(i) indizes(i) = j i = i + 1 ElseIf vData(j, 1) = StartDatum And vData(j, 2) = 0.25 Then ReDim Preserve indizes(i) indizes(i) = j i = i + 1 End If Next j Application.ScreenUpdating = False For j = LBound(indizes) To UBound(indizes) .Cells(indizes(j), 1).EntireRow.Delete Next j Application.ScreenUpdating = True End With Debug.Print Round((Timer_.MicroTimer - t), 2) & "ms" End Sub

#If VBA7 Then Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias _ "QueryPerformanceFrequency" (cyFrequency As Currency) As Long Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias _ "QueryPerformanceCounter" (cyTickCount As Currency) As Long #Else Private Declare Function getFrequency Lib "kernel32" Alias _ "QueryPerformanceFrequency" (cyFrequency As Currency) As Long Private Declare Function getTickCount Lib "kernel32" Alias _ "QueryPerformanceCounter" (cyTickCount As Currency) As Long #End If Public Function MicroTimer() As Double ' returns seconds ' uses Windows API calls to the high resolution timer Dim cyTicks1 As Currency Dim cyTicks2 As Currency Static cyFrequency As Currency MicroTimer = 0 ' get frequency If cyFrequency = 0 Then getFrequency cyFrequency ' get ticks getTickCount cyTicks1 getTickCount cyTicks2 If cyTicks2

Dim rngDel As Range 'Zeilen zählen Zeilenzahl = .Range("B1").CurrentRegion.Rows.Count 'Zielbereich festlegen For j = 2 To Zeilenzahl 'Datum außerhalb Einträge entfernen Select Case .Cells(j, 5) + .Cells(j, 6) 'Datum+Zeit Case startDatum + 0.25 To endDatum + 1 + 0.249999 'nix machen Case Else 'Zeile merken If rngDel Is Nothing Then Set rngDel = .Rows(j) Else Set rngDel = Union(rngDel, .Rows(j)) End If End Select 'Einträge vor der ersten Frühschicht entfernen Next j If Not rngDel Is Nothing Then rngDel.Delete

Sub test() Dim Startdatum As String Dim Enddatum As String Startdatum = InputBox("Start") Enddatum = InputBox("Ende") If IsDate(Startdatum) And IsDate(Enddatum) Then With ActiveSheet.Cells(1, 1).CurrentRegion With .Columns(.Columns.Count + 1) .FormulaLocal = "=wenn(oder((E1+F1)=" & CDbl(CDate(Enddatum)) + 1.25 & ");0;Zeile())" .Cells(1, 1).Value = 0 .EntireRow.RemoveDuplicates .Column, xlNo .ClearContents End With End With End If End Sub

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

schneller löschen?

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread