Supportnet / Forum / Tabellenkalkulation
Excel Problem
Frage
Hallo alle miteinander,
folgendes Problem:
Ich habe eine Excelliste, in Spalte A habe ich das Datum bis ins Jahr 2009, in Spalte B habe ich den Wochentag stehen. Jetzt möchte ich alle zeilen löschen die ein Freitag, Samstag oder Sonntag sind.
Bin mit meinem Makro durchgegangen und gesagt wenn spalte B Zeile x (Laufvariable) = Freitag dann löschen. Das selbe mit Samstag und Sonntag. Funktioniert aber nur in der ersten Woche da die zeilen dann nach oben verschoben werden aber für das vba programm nicht.
Beispiel.
zu beginn:
Zeile 6,7,8 stehen Freitag, Samstag, Sonntag drinnen, also auch in Zeile
13 bis 15. Wenn das programm nun startet löscht es Zeile 678 und 13 bis 15 raus, nur stimmt 13-15 nicht mehr, da die zeilen ja nach oben verschoben wurden und somit müsste zeile 10-12 gelöscht werden tuts aber nicht.
Hier noch mein VBA Code:
k = 2
Do While Worksheets("Sheet1").Cells(k, 1).Value <> ""
test = Worksheets("Sheet1").Cells(k, 2).Value
If Worksheets("Sheet1").Cells(k, 2).Value = "Freitag" Then
test2 = Rows(k)
Rows(k).Select
Selection.Delete Shift:=xlUp
ElseIf Worksheets("Sheet1").Cells(k, 2).Value = "Samstag" Then
Rows(k).Select
Selection.Delete Shift:=xlUp
ElseIf Worksheets("Sheet1").Cells(k, 2).Value = "Sonntag" Then
Rows(k).Select
Selection.Delete Shift:=xlUp
End If
k = k + 1
Loop
Vielen Dank für eure hilfe
Gruß
Rainer
Antwort 1 von Tropetenecho
Grüezi Rainer
Nimm folgenden Code. Er löscht von unten nach oben.
Sub Löschen_Freitag_bis_Sonntag()
Application.ScreenUpdating = False
For i = Range("A65536").End(xlUp).Row To 2 Step -1
If Weekday(Cells(i, 1)) = 1 Or Weekday(Cells(i, 1)) > 5 _
Then Cells(i, 1).EntireRow.Delete
Next i
Application.ScreenUpdating = True
End Sub
Nimm folgenden Code. Er löscht von unten nach oben.
Sub Löschen_Freitag_bis_Sonntag()
Application.ScreenUpdating = False
For i = Range("A65536").End(xlUp).Row To 2 Step -1
If Weekday(Cells(i, 1)) = 1 Or Weekday(Cells(i, 1)) > 5 _
Then Cells(i, 1).EntireRow.Delete
Next i
Application.ScreenUpdating = True
End Sub