Office: Makro Laufzeit verkürzen

Hallo zusammen,

ich hätte eine allgemeine Frage...

Ich Habe ein makro, welches einwandfrei läuft, aber sehr lange braucht bis es vollständig ausgeführt wird...

Beispielsweise braucht es für 23 Tabellenblätter ca. 15-20 min...
Der code würde folgendermaßen Lauten:

PHP:

         Option Explicit
Sub Test_letzte()
Application.ScreenUpdating = False
Dim letzteSpalte    As Long
Dim n               As Long
Dim i               As Long
Dim Anzahl_A      As Long
Dim Anzahl_F      As Long
Dim Anzahl_L     As Long
Dim WS              As Worksheet


For Each WS In Worksheets


If WS.Name <> "Dummy" Then
If WS.Name <> "Ergebnis" Then
If WS.Name <> "A_Fehler" Then
If WS.Name <> "F_Fehler" Then

Worksheets(WS.Name).Select


Anzahl_A = Worksheets("Dummy").Range("D3")
Anzahl_F = Worksheets("Dummy").Range("d4")
Anzahl_L = Worksheets("Dummy").Range("d5") ' Aufruf mit Startzeile


i = 2
For n = 1 To Anzahl_F

Call ttt(i, Anzahl_L + 2)

i = 2 + 11 * n
Next n

End If
End If
End If
End If

Next WS

End Sub
Sub ttt(Startzeile As Long, letzteSpalte As Long)
Application.ScreenUpdating = False
Dim Summe_p         As Range
Dim STD_s           As Range
Dim STD_t           As Range
Dim x_range         As Range
Dim y_Range         As Range
Dim WS              As Worksheet


Dim Anzahl_A        As Long
Dim Anzahl_F        As Long
Dim Anzahl_L       As Long

Dim a               As Long
Dim n               As Long
Dim letzteSpalte_p  As Long


' Zeilenindizes
Dim s               As Long
Dim t               As Long
Dim x               As Long
Dim y               As Long
Dim p               As Long
Dim sum_p           As Long
Dim std_x           As Long
Dim std_y           As Long
Dim produkt_stdx_stdy As Long
Dim Lots            As Long
Dim Kor_k           As Long

Anzahl_A = Worksheets("Dummy").Range("D3")  '=23
Anzahl_F = Worksheets("Dummy").Range("d4")  '=34
Anzahl_L = Worksheets("Dummy").Range("d5")  '=20

For Each WS In Worksheets


If WS.Name <> "Dummy" Then
If WS.Name <> "Ergebnis" Then
If WS.Name <> "A_Fehler" Then
If WS.Name <> "F_Fehler" Then

Worksheets(WS.Name).Select
' Zeilenindizes aus Startzeile berechnen
s = Startzeile
t = Startzeile + 1
x = Startzeile + 2
y = Startzeile + 3
p = Startzeile + 4
a = Startzeile + 1
sum_p = Startzeile + 5
std_x = Startzeile + 6
std_y = Startzeile + 7
produkt_stdx_stdy = Startzeile + 8
Lots = Startzeile + 9
Kor_k = Startzeile + 10

Set x_range = Worksheets(WS.Name).Range(Cells(s, 3), Cells(s, Anzahl_L + 2))
Set y_Range = Worksheets(WS.Name).Range(Cells(t, 3), Cells(t, Anzahl_L + 2))

a = 3
For n = 1 To Anzahl_L



Cells(1, Anzahl_L + 3) = "Mittelwert"
Cells(s, Anzahl_L + 3) = Application.WorksheetFunction.Average(x_range)   ' Mittelwert A
Cells(t, Anzahl_L + 3) = Application.WorksheetFunction.Average(y_Range)   ' Mittelwert F




Cells(x, 2) = "A - Mittelwert"
Cells(x, a) = Cells(s, a).Value - Cells(s, Anzahl_L + 3).Value ' x - MW
Cells(y, 2) = "F - Mittelwert"
Cells(y, a) = Cells(t, a).Value - Cells(t, Anzahl_L + 3).Value ' y- MW

Cells(p, 2) = "(A - Mittelwert) * (F - Mittelwert)"
Cells(p, a) = Cells(x, a).Value * Cells(y, a).Value ' Produkt   (x - MW) *  (y- MW)
a = 3 + n
Next n
Set Summe_p = Worksheets(WS.Name).Range(Cells(p, 3), Cells(p, Anzahl_L + 2))

Cells(sum_p, 2) = "Summe von Produkten"
Cells(sum_p, 3) = Application.WorksheetFunction.Sum(Summe_p)  ' Summe von Produkten

Set STD_s = Worksheets(WS.Name).Range(Cells(s, 3), Cells(s, Anzahl_L + 2))
Set STD_t = Worksheets(WS.Name).Range(Cells(t, 3), Cells(t, Anzahl_L + 2))

Cells(std_x, 2) = "Standardabweichung von A"
Cells(std_x, 3) = Application.WorksheetFunction.StDev(STD_s)  ' STD x

Cells(std_y, 2) = "Standardabweichung von F"
Cells(std_y, 3) = Application.WorksheetFunction.StDev(STD_t) ' Std y

Cells(produkt_stdx_stdy, 2) = "(STD A) * (STD F)"
Cells(produkt_stdx_stdy, 3) = Cells(std_x, 3).Value * Cells(std_y, 3).Value  ' Produkt von STD x und STD y

Cells(Lots, 2) = "Anzahl_L"
Cells(Lots, 3) = Anzahl_L

Cells(Kor_k, 2) = "Korrelationskoeffizient"
Cells(Kor_k, 3) = 1 / (Anzahl_L - 1) * Cells(sum_p, 3).Value / Cells(produkt_stdx_stdy, 3).Value ' Korrelationskoeffizient

End If
End If
End If
End If

Next WS


End Sub


:)

 

Arbeite grundsätzlich mit Variant-Arrays:

a = [A1:Z99999] 'Bereich in Array, inklusive Leerzellen für die Ergebnisse
a(i, j) = ... 'irgendwelche Zuweisungen
[A1:Z99999] = a 'zurück ins Arbeitsblatt

 

Hallo,

eine ernsthafte Beschleunigung (40x-100x) erreicht man, wenn man Bereiche auf einmal in ein Array kopiert "Ar=range("A1:F500") und alle Berechnung im Array durchführt. Viele, aber nicht alle, Arbeitsblattfunktionen klappen auch in Arrays.

Deinen code durchzugehen und umschreiben, ist mir zu mühsam.

mfg

 

Vielen Dank *Smilie

Ich werde mal schauen ob ich es schaffe *Smilie

da ich noch keine Erfahrungen mit Arrays habe, werde ich mich da mal einlesen und schauen ich es hinbekomme *biggrin.gif*

 

Hallo remix92,

wenn Du diese Ereignisprozedur
Private Sub Worksheet_Change(ByVal Target As Range)
in Deinen Worksheets definiert hast, dann mußt Du mit Code:

arbeiten, damit die Spaßbremsen von Excel vorrübergehend gelöst werden. Dies beschleunigt das Makro auch ohne Arrays schon ungemein. Trotzdem ist der Hinweis auf die Arrays sehr sinnvoll, nur bedeutet das auch sehr viel Aufmerksamkeit vom Programmierer, da sich bei jeder Strukturänderung der Tabelle Anpassungen am Array erfolgen müssen.
Schau auch mal nach: Excel Vba GetMoreSpeed
Da sind die 4 oberen Einstellungen in einer Prozedur hinterlegt.

Gruß von Luschi
aus klein-Paris

 

Vielen Dank für eure Antworten *Smilie

Also hab veruscht Arrays zu "erstellen" leider ohne Erfolg..

Könnt ihr vllt ein kleines Beispiel Makro einfügen, wie das Array denn aussehen sollte.
Wäre sehr nett von euch *Smilie

@Luschi
Dein Tipp erspart mir ungefähr die Hälfte der zeit.
Dir auch vielen Dank!!!

 

Hallo,

ohne die Daten ist der Code nur schwer nachvollziehbar.

Die verwendeten Funktionen kann man so im Array rechen:

PHP:

         Dim WSF As WorksheetFunction
Sub Mittelwert()
Set WSF = Application.WorksheetFunction
Ar = Range("A2:A6")
MM = WSF.Average(Ar)

Su = WSF.Sum(Ar)

St_Dev = WSF.StDev_P(Ar)
Debug.Print MM, Su, St_Dev
End Sub


 

Hier mein Beispiel:

Zellbereichskopie in VBA schnell bearbeiten ("Gegenueberstellung")

Seitdem bin ich von Variant-Arrays begeistert.

 

Hallo,

Also ich habe mal ein Test File hochgeladen...

Bei mir scheitert es daran, dass ich eine For Schleife habe und je nachdem, was In Worksheet "Dummy" eingegeben wird, wird es so oft ausgeführt...

Wäre es nur einmal auszuführen, wäre es easy das umzusetzen...