Löschen auch mit Zeit

Sub DuplikateLoeschen() Dim i& Application.ScreenUpdating = False For i = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1 If Application.CountIf(Range(Cells(14, "A"), Cells(i, "A")), Cells(i, "A")) > 1 Then Cells(i, "A").EntireRow.Delete End If Next Application.ScreenUpdating = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub DuplikateLoeschen() Dim i& Application.ScreenUpdating = False For i = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1 If Hour(Cells(i, "A")) >= 7 And Hour(Cells(i, "A")) 1 Then End If Next Application.ScreenUpdating = True End Sub

Sub DuplikateLoeschen() Dim i& Application.ScreenUpdating = False For i = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1 If Hour(Cells(i, "A")) >= 7 And Hour(Cells(i, "A")) 1 Then Cells(i, "A").EntireRow.Delete End If Next Application.ScreenUpdating = True End Sub

Hallo Chris,
ein paar Anmerkungen:
1. in Spalte A steht Text, macht aber nichts
(das siehst du, wenn du die Spalte A vergrößerst, dann sind die "Zahlen" linksbündig ausgerichtet)
2. deine Uhrzeiten stehen in Spalte B und nicht in Spalte A, im Code prüfst du aber Spalte A
3. die Typenunverträglichkeit bekommst du, weil du die Schleife von unten nach oben bis zur Zeile 1 laufen lässt. Deine zu prüfenden Daten gehen aber erst ab Zeile 14 los. In Zeile 13 steht aber Text (Überschriften) und da läuft der Code dann auf den Fehler mit den Typenunvertäglichkeit
4. Prüfung der Uhrzeiten mit And, Application.CountIf dann aber mit Or
Teste mal mit diesem geänderten Code:

Option Explicit
Sub DuplikateLoeschen()
Dim i&
Application.ScreenUpdating = False
For i = Cells(Rows.Count, "A").End(xlUp).Row To 14 Step -1
If Hour(Cells(i, "B")) >= 7 And Hour(Cells(i, "B"))  1 Then
Rows(i).Delete
End If
Next
Application.ScreenUpdating = True
End Sub

Gruß Werner

Option Explicit Sub DuplikateLoeschen() Dim i& Application.ScreenUpdating = False For i = Cells(Rows.Count, "A").End(xlUp).Row To 14 Step -1 If Cells(i, "B") >= 0.291666666666667 And Cells(i, "B") 1 Then Rows(i).Delete End If Next Application.ScreenUpdating = True End Sub

Option Explicit Sub DuplikateLoeschen() Dim i& Application.ScreenUpdating = False For i = Cells(Rows.Count, "A").End(xlUp).Row To 14 Step -1 If Hour(Cells(i, "B")) >= "7:00:00" And Hour(Cells(i, "B")) 1 Then Rows(i).Delete End If Next Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

	A
16	19.12.2016 20:06
17	15.12.2016 08:06
18	16.12.2016 20:06
19	17.12.2016 20:06
20	18.12.2016 20:06
21	19.12.2016 20:06

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread