AW: Und die Formel aus O6 ?
03.11.2012 09:16:56
Tino
Hallo,
soll dieses Makro in einer Schleife bleiben oder immer wieder neu gestartet werden.
Mit Schleife müsste so gehen.
Sub Makro1()
Dim ArrayData, tmpArr, n&, nn&
Application.ScreenUpdating = False
With Tabelle2.Range("D14:L22")
Do While Tabelle2.Range("O13") > 0
ArrayData = .Value
tmpArr = .Offset(-10, 0).FormulaR1C1
For n = 1 To Ubound(ArrayData)
For nn = 1 To Ubound(ArrayData, 2)
If ArrayData(n, nn) <> "" Then
If IsNumeric(ArrayData(n, nn)) Then tmpArr(n, nn) = ArrayData(n, nn)
End If
Next nn
Next n
.Offset(-10, 0).FormulaR1C1 = tmpArr
Loop
End With
Application.ScreenUpdating = True
End Sub
Immer wieder neu starten geht so.
kommt als Code in DieseArbeitsmappe
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime nTime, "Makro1", Schedule:=False
End Sub
kommt als Code in Modul1
Option Explicit
Public nTime As Date
Sub Makro1()
Dim ArrayData, tmpArr, n&, nn&
Application.ScreenUpdating = False
With Tabelle2.Range("D14:L22")
ArrayData = .Value
tmpArr = .Offset(-10, 0).FormulaR1C1
For n = 1 To Ubound(ArrayData)
For nn = 1 To Ubound(ArrayData, 2)
If ArrayData(n, nn) <> "" Then
If IsNumeric(ArrayData(n, nn)) Then tmpArr(n, nn) = ArrayData(n, nn)
End If
Next nn
Next n
.Offset(-10, 0).FormulaR1C1 = tmpArr
End With
Range("O13") = Range("O13") - 1
Application.ScreenUpdating = True
If Tabelle2.Range("O13") > 0 Then
nTime = Now + TimeSerial(0, 0, 1)
Application.OnTime nTime, "Makro1"
End If
End Sub
Gruß Tino