Ich möchte mittels Makrobefehl unter der letzten Zelle mit Inhalt in Spalte A, D, G, J und M 00:00:00 eintragen lassen. Allerdings nur bis Reihe 10.
Besten Dank für eure Hilfe.
Gruß
Karsten
Sub Zeit_00_00_00()
'Trägt Zeit 00:00:00 in leere Zellen in bestimmte Spalten
Const ZeileMax As Long = 10 'Letzte Zeile in der Eingetragen werden soll
Dim wks As Worksheet, StatusCalculation As Long, StatusEvents As Boolean
Dim Zeit As Date
Dim arrSpalten, intI As Long, Spalte As Long, Zeile As Long
Set wks = ActiveSheet
'Zeit und Spalten festlegen
Zeit = TimeValue("00:00:00")
arrSpalten = Array(1, 4, 7, 10, 13) 'A, D, G, J und M )
'Excel so einstellen, Makroausführung nicht gebremst wird
With Application
.ScreenUpdating = False
StatusCalculation = .Calculation
If StatusCalculation xlCalculationManual Then
.Calculation = xlCalculationManual
End If
StatusEvents = .EnableEvents
If StatusEvents = True Then
.EnableEvents = False
End If
End With
For intI = LBound(arrSpalten) To UBound(arrSpalten)
Spalte = arrSpalten(intI)
For Zeile = ZeileMax To 1 Step -1
If IsEmpty(wks.Cells(Zeile, Spalte)) Then
wks.Cells(Zeile, Spalte).Value = Zeit
Else
Exit For
End If
Next
Next
'Excel-Einstellungen wieder zurücksetzen
With Application
.ScreenUpdating = True
If StatusCalculation .Calculation Then
.Calculation = StatusCalculation
End If
If StatusEvents .EnableEvents Then
.EnableEvents = StatusCalculation
End If
End With
'Objekte und Arrays zurücksetzen
Set wks = Nothing
arrSpalten = Null
End Sub
For intI = LBound(arrSpalten) To UBound(arrSpalten)
Spalte = arrSpalten(intI)
'Prüfen, ob letzte Zeile - hier ZeileMax=10 - schon ausgefüllt
If IsEmpty(wks.Cells(ZeileMax, Spalte)) Then
For Zeile = ZeileMax To 1 Step -1
'Prüfung ob Zelle in Zeile Leer und Zeile = 1
If IsEmpty(wks.Cells(Zeile, Spalte)) _
And Zeile = 1 Then
wks.Cells(Zeile, Spalte).Value = Zeit
'Prüfung ob Zelle in Zeile Leer und in Zeile oberhalb ausgefüllt
ElseIf IsEmpty(wks.Cells(Zeile, Spalte)) _
And Not IsEmpty(wks.Cells(Zeile - 1, Spalte)) Then
wks.Cells(Zeile, Spalte).Value = Zeit
Exit For
End If
Next
End If
Next
For intI = LBound(arrSpalten) To UBound(arrSpalten)
Spalte = arrSpalten(intI)
'Prüfen, ob letzte Zeile - hier ZeileMax=10 - schon ausgefüllt
If IsEmpty(wks.Cells(ZeileMax, Spalte)) Then
For Zeile = ZeileMax To 1 Step -1
'Prüfung ob Zelle in Zeile Leer und Zeile = 1
If IsEmpty(wks.Cells(Zeile, Spalte)) _
And Zeile = 1 Then
wks.Cells(Zeile, Spalte).Value = Zeit
'Prüfung ob Zelle in Zeile Leer und in Zeile oberhalb ausgefüllt
ElseIf IsEmpty(wks.Cells(Zeile, Spalte)) _
And Not IsEmpty(wks.Cells(Zeile - 1, Spalte)) Then
'Prüfung ob schon 00:00:00 in Zelle steht
If wks.Cells(Zeile - 1, Spalte) = 0 Then
Exit For
Else
wks.Cells(Zeile, Spalte).Value = Zeit
Exit For
End If
End If
Next
End If
Next