Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
164to168
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
164to168
164to168
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Nochmal Datum älter als 5Tage

Nochmal Datum älter als 5Tage
29.09.2002 07:19:20
Dieckie
Hallo Rainer
Habe es ebenfalls ausgeführt und klappt auch.
Wie kriege ich es hin, das nur die Zeilen kopiert werden
in den auch ein Datum steht.
Die Zeilen in denen noch kein Datum steht sollen unverändert bleiben.

MfG Micha

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: Nochmal Datum älter als 5Tage
29.09.2002 07:22:41
Hajo_Zi
Hallo Dieckie

das ist eben der Nachteil, wenn ein neuer Beitrag angefangen wird für ein altes Problem die Übersichtlichkeit geht verloren. Vielleicht erinnnert sich Rainer noch an das Problem und die vorgeschlagene Lösung und kann die eine neue Lösung Posten. Ich würde schreiben für alle anderen sieht es schlecht aus.

Gruß Hajo

Re: Nochmal Datum älter als 5Tage
29.09.2002 09:48:35
Dieckie
Hallo Hajo

Habe diese Anfrage auch im alten Beitrag "Datum älter als 5 Tage"
gestellt. Da aber keine Antwort kam,deshalb neuer Versuch.
Hier noch mal die Lösung von Rainer, die auch geht, bis auf
die Zeilen ohne Datum, die unverändert bleiben sollen.

Sub Delete_Old_Rows()
Dim i As Integer, CrWks1 As Long, CrWks2 As Long
Dim wks1 As Worksheet, wks2 As Worksheet
Set wks1 = Worksheets("Tabelle1")
Set wks2 = Worksheets("Tabelle2")
CrWks1 = 65536
CrWks2 = 65536
If wks1.Cells(CrWks1, 1) = "" Then
CrWks1 = wks1.Cells(CrWks1, 1).End(xlUp).Row
End If
If wks2.Cells(CrWks2, 1) = "" Then
CrWks2 = wks2.Cells(CrWks2, 1).End(xlUp).Row
End If
For i = CrWks1 To 1 Step -1
If Format(wks1.Cells(i, 1), "dd.mm.yy") < Format(Now() - 5, "dd.mm.yy") Then
CrWks2 = CrWks2 + 1
wks1.Rows(i).Copy Destination:=wks2.Rows(CrWks2)
wks1.Rows(i).Delete Shift:=xlDown
End If
Next i
End Sub

MfG Micha

Anzeige
Re: Nochmal Datum älter als 5Tage
29.09.2002 10:37:23
Ramses
Hallo Micha,

es sei mir gestattet mein Wochenende so zu verbringen wie ich es gerne hätte :-))

Sub Delete_Old_Rows()
Dim i As Integer, CrWks1 As Long, CrWks2 As Long, crwks As Long
Dim wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet
Set wks1 = Worksheets("Tabelle1")
Set wks2 = Worksheets("Tabelle2")
Set wks3 = Worksheets("Tabelle3")
CrWks1 = 65536
CrWks2 = 65536
If wks1.Cells(CrWks1, 1) = "" Then
    CrWks1 = wks1.Cells(CrWks1, 1).End(xlUp).Row
End If
If wks2.Cells(CrWks2, 1) = "" Then
    CrWks2 = wks2.Cells(CrWks2, 1).End(xlUp).Row
End If
For i = CrWks1 To 1 Step -1
    If Format(wks1.Cells(i, 1), "dd.mm.yy") < Format(Now() - 5, "dd.mm.yy") Then
        CrWks2 = CrWks2 + 1
        wks1.Rows(i).Copy Destination:=wks2.Rows(CrWks2)
        wks1.Rows(i).Delete Shift:=xlDown
    End If
Next i
'---
'Ab hier werden nur die mit leerem Datum kopiert
'---
CrWks1 = 65536
CrWks3 = 65536
If wks1.Cells(CrWks1, 1) = "" Then
    CrWks1 = wks1.Cells(CrWks1, 1).End(xlUp).Row
End If
If wks3.Cells(CrWks3, 1) = "" Then
    CrWks3 = wks3.Cells(CrWks3, 1).End(xlUp).Row
End If
For i = 1 To CrWks1
    If wks1.Cells(i, 1) = "" Then
        CrWks3 = CrWks3 + 1
        wks1.Rows(i).Copy Destination:=wks3.Rows(CrWks3)
    End If
Next i
End Sub
     Code eingefügt mit Syntaxhighlighter 1.14

Gruss Rainer

Anzeige
Re: Nochmal Datum älter als 5Tage
29.09.2002 11:00:15
Dieckie
Hallo Rainer

Sorry, so wars nicht gemeint.

Habe eben gelesen, daß mein Text mißverständlich ist.
In Tabelle 1 sollen die Ohne Datum stehen bleiben und nicht mitkopiert werden.

Mfg Micha

Re: Nochmal Datum älter als 5Tage
29.09.2002 11:09:22
Ramses
Hallo Micha,

also wenn ich dich richtig verstanden habe, willst du alle Daten kopieren, ausser den Zeilen, in denen im Feld Datum kein Wert steht.

Sub Delete_Rows_without_Date()
Dim i As Integer, CrWks1 As Long, CrWks2 As Long, crwks As Long
Dim wks1 As Worksheet, wks2 As Worksheet
Set wks1 = Worksheets("Tabelle1")
Set wks2 = Worksheets("Tabelle2")
CrWks1 = 65536
CrWks2 = 65536
If wks1.Cells(CrWks1, 1) = "" Then
    CrWks1 = wks1.Cells(CrWks1, 1).End(xlUp).Row
End If
If wks2.Cells(CrWks2, 1) = "" Then
    CrWks2 = wks2.Cells(CrWks2, 1).End(xlUp).Row
End If
For i = CrWks1 To 1 Step -1
    'Jetzt werden alle Zeilen kopiert,
    'wenn in der Zelle Datum kein Wert steht
    If wks1.Cells(i, 1) <> "" Then
        CrWks2 = CrWks2 + 1
        wks1.Rows(i).Copy Destination:=wks2.Rows(CrWks2)
        wks1.Rows(i).Delete Shift:=xlDown
    End If
Next i
End Sub
     Code eingefügt mit Syntaxhighlighter 1.14

Gruss Rainer

Anzeige
Re: Nochmal Datum älter als 5Tage
29.09.2002 12:03:49
Dieckie
Hallo Rainer

Ja richtig, haut hin,
nur sollte jetzt die Bedingung mit dem Datum,
Kopiere Zeile älter als X Tage noch erfüllt werden.

Gruß Micha


Re: Nochmal Datum älter als 5Tage
29.09.2002 12:43:41
Dieckie
Hallo Rainer

Habe meine Aufgabe gelöst.
Besten Dank für die Lösung.
Schönen Sonntag noch.

Mfg Micha

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige