AW: Unter letzte Zelle Inhalt einfügen
11.09.2009 09:41:21
fcs
Hallo Karsten,
mein Vorschlag
Mangels Kenntnis deiner Datei hab ich auch die Anpassungen der Exceleinstellungen eingebaut, so dass das Makro nicht unnötig ausgebremst wird.
Gruß
Franz
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