Spalten mit mehrfachen Datumswerten löschen

Hallo zusammen,
ich brauche mal wieder Eure Hilfe. Ich habe eine Tabelle die folgenden Aufbau hat.
Zeile 1 = Überschrift
Ab Zeile 2 stehen Werte (in Spalte A jeweils Datumswerte, die Tabelle ist chronologisch sortiert, das jüngste Datum steht unten).
Jetzt möchte ich - da am Tag Mehrfacheingaben erfolgen - pro Tag nur zwei Datumswerte stehen lassen (das erste und das letzte).
Beispiel:
16.01.2009
17.01.2009 - nicht löschen
17.01.2009 - löschen
17.01.2009 - nicht löschen
Wichtig: es müssen immer zwei Datumswerte (der oberste und der unterste) stehen bleiben. Nach der Löschung von oben, sähe das Beispiel so aus.
Beispiel:
16.01.2009
17.01.2009 - nicht löschen
17.01.2009 - nicht löschen
Es muss immer die ganze Zeile gelöscht werden.
Es darf nicht zum Absturz kommen, wenn mal nur ein Datumswert am Tag enthalten ist. Auch das kann
vorkommen.
Vielen Dank!
Liebe Grüße
Claudia

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public Sub Herausloeschen() Dim lZeile As Long With ThisWorkbook.Worksheets("Tabelle1") For lZeile = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 If Application.WorksheetFunction.CountIf(.Columns(1), _ .Range("A" & lZeile).Value) > 2 Then .Rows(lZeile - 1).Delete shift:=xlUp End If Next lZeile End With End Sub

Sub Loeschen() Dim L As Long With Sheets("Tabelle1") For L = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 If .Cells(L, 1).Value = .Cells(L - 1, 1).Value _ And .Cells(L, 1).Value = .Cells(L + 1, 1).Value Then _ .Cells(L, 1).EntireRow.Delete Next L End With End Sub

Hallo,
teste mal diese Version, dafür wird die letzte Spalte in Deiner Tabelle verwendet,
diese muss also noch frei sein.

Sub LoescheDoppelteZwischenZeilen()
Dim Bereich As Range, FormelZ As Range
Dim LRow As Long, LCol As Long

Set Bereich = Range("A2", Cells(Rows.Count, 1).End(xlUp))
If Not Intersect(Bereich, Rows(1)) Is Nothing Then Exit Sub

LRow = Bereich(Bereich.Cells.Count).Row
LCol = Columns.Count - Bereich.Column

Set FormelZ = Bereich.Offset(0, LCol)

Application.ScreenUpdating = False
    
    FormelZ.FormulaR1C1 = _
    "=IF(AND(COUNTIF(RC1:R" & LRow & "C1,RC1)<>COUNTIF(R1C1:R" & LRow & "C1,RC1),COUNTIF(RC1:R" & LRow & "C1,RC1)>1),0,"""")"
    If Application.CountIf(FormelZ, 0) > 0 Then
     FormelZ.SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete
    End If
 
    Columns(FormelZ.Column).Delete
Application.ScreenUpdating = True
End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

Spalten mit mehrfachen Datumswerten löschen

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

322 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Spalten mit mehrfachen Datumswerten löschen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

322 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread