Hallo Boby,
in dem Fall muss nur eine kleine Ergänzungs vorgenommen werden:
Option Explicit
Sub DeleteAF(ByVal lngRow As Long)
Dim wsh As Worksheet
Dim rng As Range
Dim iCol As Integer
Dim bEmpty As Boolean
Set wsh = ActiveWorkbook.Worksheets(1)
bEmpty = True
For iCol = 32 To 3 Step -1
With wsh.Cells(lngRow, iCol)
If iCol = 3 Then
If Not bEmpty Then
If lngRow = 2 Then
.Value = Date
Else
.ClearContents
.NumberFormat = "General"
End If
End If
Else
If IsEmpty(.Offset(ColumnOffset:=-1).Value) Then
.ClearContents
.NumberFormat = "General"
Else
.Value = .Offset(ColumnOffset:=-1).Value
bEmpty = False
End If
End If
End With
Next
End Sub
Sub FixAll()
Dim iRow As Integer
Dim myCalc As XlCalculation
myCalc = Application.Calculation
Application.Calculation = xlManual
For iRow = 2 To 30
DeleteAF iRow
Next
Application.Calculate
Application.Calculation = myCalc
End Sub
Das die Laufzeit so lange ist, kann an den Formeln liegen. Standardmäßig werden die Formeln nach jeder Änderung automatisch neu berechnet. Je nach Umfang der Formeln kann es daher etwas dauern.
Beim Aufruf von "FixAll" wird die Automatische Berechnung temporär auf Manuell umgestellt.
In der Variable myCalc wird das zuvor eingestellte Verfahren gespeichert. Mit deren Hilfe wird die Automatische Berechnung am Ende wieder auf das zuvor eingestellte Verfahren zurück gesetzt.
Nun sollte es performanter ablaufen.
Ab der 3. Zeile werden wie gewünschte in der Spalte C keine Inhalte mehr eingetragen. Das Zahlenformat für die Zellen C3 bis max. C30 ist auf "Standard" fstgelegt.
LG, Ben
|