abuelito
Goto Top

Excel VBA - Jede Zeile ohne aktuelles Datum entfernen

Hallo an Alle,

ich habe folgendes Problem und hoffe, dass ihr mir wieder helfen könnt face-smile

Ich habe eine Tabelle1 (60 Spalten) mit einer Überschriftenzeile (Zeile1) und dann folgen ab Zeile2 etliche Zeilen mit Inhalten. Jetzt möchte ich gerne alle Zeilen löschen, wenn das Datum aus der Spalte AH nicht = heute ist (Datumsformat falls relevant wäre 05.07.2017). Anschließend speichern und schließen.

Folgender Ablauf wäre gut:

1. Datei wird geöffnet
2. Abfrage mit Löschvorgang
3. Datei speichern
4. Datei schließen

Wie mache ich das?

Vielen lieben Dank
Grüße

Content-Key: 342543

Url: https://administrator.de/contentid/342543

Printed on: April 19, 2024 at 21:04 o'clock

Member: opalka
Solution opalka Jul 05, 2017 updated at 19:12:33 (UTC)
Goto Top
Hallo,

mal so kurz hingeschrieben. Und diesen Code mit einer Schaltfläche verbinden und ausführen.

Sub ZeilenLöschen()
    Dim ws As Worksheet
    Dim rng As Range
    Dim datum As Date
    Dim heute As Date
    
    Set ws = ActiveSheet
    Set rng = ws.Range("AH2")  
    heute = DateSerial(Year(Now), Month(Now), Day(Now))
    Do Until rng.Row > ws.UsedRange.Rows.Count
        datum = rng.Value
        If Not datum = heute Then
            Set rng = rng.Offset(1, 0)
            rng.Offset(-1).EntireRow.Delete xlShiftUp
        Else
            Set rng = rng.Offset(1, 0)
        End If
    Loop
End Sub

Gruß
Member: rentner63
Solution rentner63 Jul 06, 2017 at 06:31:23 (UTC)
Goto Top
Hallo!

Beim Löschen von Zeilen ist es sinnvoll bei der letzten Zeile zu beginnen:
Sub test()
    Dim dblDate As Date, i As Long
    
    With ActiveSheet
        dblDate = Date
        For i = .Cells(.Rows.Count, "AH").End(xlUp).Row To 2 Step -1  
            If .Cells(i, "AH").Value <> dblDate Then  
                .Rows(i).Delete
            End If
        Next
    End With
End Sub

Gruß Dieter
Member: abuelito
abuelito Jul 06, 2017 at 08:36:48 (UTC)
Goto Top
Super, vielen Dank .. es funktioniert
Grüße
Member: abuelito
abuelito Jul 06, 2017 at 08:37:32 (UTC)
Goto Top
Super, auch das funktioniert einwandfrei .. Vielen Dank
Grüße