Langsames VBA-Script nur bei grossen Datenmengen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:


Excel-Version: 5.0/7.0
nach unten

Betrifft: Langsames VBA-Script nur bei grossen Datenmengen
von: Michael Fluck
Geschrieben am: 13.05.2002 - 14:11:10

Halloi zusammen,

Problembeschreibung:
Ich habe ein Datei mit 20000 belegten Zeilen und lese blockweise
je 5 Zellen, einiger Zeilen ein. Ich schreibe dann die eingelesenen Werte in Array's um dann so weiterzurechnen. Die Berechnung ist relativ komplex.
Nach verschiedenen Optimierungen im Algorithmus komme ich auf ca. 8,5s je 100 Zeilen. Dies gilt aber nur bis ca. zur 500. Zeile. Ab da verlängern sich die rechenzeiten immer mehr ! Die Datei durchzurechnen würde nach hochrechnungen dann so 1-2h dauern.

Die Gesamtzahl der eingelesenen Zellen liegt immmer bei ca. 60-100 auf einmal. Ich habe den Worksheet-Zugriff optimiert. Es werden keine rekursiven Algorithmen verwendet, es werden keine Tabellenfunktionen oder Ranges aufgerufen, Application.ScreenUpdating = False, Calculation = xlCalculationManual sind gesetzt und die Variablenverwendung ist optimiert. Im RAM ist (Application.MemoryFree) ist auch immer 1MB frei (von 256MB). Zum einlesen der Zellenbereiche verwende ich ausschliesslich die Form Range("C" & startblock).Resize(länge, 1).

Das ganze Vorhaben liesse sich nat. in einer Datenbank schneller abwickeln, aber für diese Umsetzung ist im Moment keine
Zeit insbesondere deshalb, weil der Algorithmus funktioniert.

Daher die Fragen:

Andere Foren ?

Gibt es (mir nicht bekannte) Befehle zum expliziten freigeben von Variablen ausser (clear, redim) ?

Wie kann ich die anfängliche rechenzeit von 8,5s für die ganze Datei beibehalten !!!!!!!!!!!!!??? Was passiert hier ?


Ich danke allen schon einmal im vorraus !

michael


nach oben   nach unten

Re: Langsames VBA-Script nur bei grossen Datenmengen
von: Andreas
Geschrieben am: 13.05.2002 - 14:23:01

Hallo Michael,

ohne den genauen Code kann man leider wenig sagen/helfen.
Poste doch mal einen Auszug!
Andreas


nach oben   nach unten

Re: Langsames VBA-Script nur bei grossen Datenmengen
von: ok hier der code
Geschrieben am: 13.05.2002 - 14:49:20

konnte mich nicht entscheiden was wichtig ist :|

ich habe die functionen ifi/verketti/countifi... nur nachgebildet, um tabellenzugriffen zu entgehen und pur in VBA zu rechnen und um das originalsystem beizubehalten, dessen einziges manko die dateigrösse von >50MB war

einsteig über CommandButton1_Click()
das einlesen geschieht nur über lesestückli()
die berechnung wird nur über berechnen() gesteuert

nochamls danke
michael

-------------------------------------------------------------------------------------

Private block_C As Variant
Private block_Q As Variant
Private block_B As Variant
Private block_B_check As Variant
Private block_F3F3 As Variant
...usw..............

-----------------------------------

Private Sub CommandButton1_Click()
Dim a
Dim c As Variant
Dim b

Application.ScreenUpdating = False
Calculation = xlCalculationManual
Application.EnableCancelKey = xlErrorHandler

'Anpassen Anfang
start_zeile = 3
maxleer = 20
ergebnisspalte = 25
'Anpassen Ende

letzterendblock = start_zeile
zeilenzähler = start_zeile

a = checkblocklänge() 'OK

block_B_check = Range("B1").Resize(blocklänge + 1, 1)
ergebnisse = block_B_check

a = schleife1()

a = writeback()

Application.ScreenUpdating = True

End Sub

---------------------------------------------------

Function schleife1()

Dim timerstart As Single
Dim timercurr As Single
Dim intervall As Long
Dim timerstartges As Single

intervall = 100
timerstart = Timer
timerstartges = Timer
zeitges = Timer

While zeilenzähler <= blocklänge

If zeilenzähler >= intervall Then
timercurr = Timer
timi = (timercurr - timerstart)
timerstart = Timer
zeitges = Timer - timerstartges
intervall = intervall + 100
End If

c = lesestückli() 'neue Arrays der nächsten Stückliste eingelesen
c = schleife2() 'dieses Array durchlaufen

Wend
End Function

---------------------------------------------------

Function schleife2() 'schleife um 1 stückli 1x zu durchlaufen (Berechnen)

Dim ii As Long

For ii = 1 To stücklilänge 'ÄNDERUNG 0/1

berechnen (ii)
zeilenzähler = zeilenzähler + 1

Next

End Function

---------------------------------------------------

Function lesestückli()
Dim stückli_new As String
Dim startblock As Long

startblock = letzterendblock

stückli_new = block_B_check(letzterendblock, 1)
stückli_last = block_B_check(letzterendblock, 1) 'um startbedingung zu realisieren

While stückli_last = stückli_new

letzterendblock = letzterendblock + 1
stückli_last = block_B_check(letzterendblock, 1) 'wenn abbruch, dann letzterendblock = startblock der neuen stückli
stücklilänge = letzterendblock - startblock

Wend

block_C = Range("C" & startblock).Resize(stücklilänge, 1)
block_Q = Range("Q" & startblock).Resize(stücklilänge, 1)
block_B = Range("B" & startblock).Resize(stücklilänge, 1)
block_F3F3 = Range("F" & startblock).Resize(stücklilänge, 1)
block_F3F4 = block_F3F3
block_Q3Q4 = block_Q
block_D3D3 = Range("D" & startblock).Resize(stücklilänge, 1)

End Function

---------------------------------------------------

Function checkblocklänge()

Dim i As Long
Dim leerzähler As Long
Dim start_zeile_old As Long

start_zeile_old = start_zeile
leerzähler = 0

While leerzähler <= maxleer
i = start_zeile
start_zeile = start_zeile + 1
If Not IsEmpty(Cells(i, 6)) Then 'wenn spalte ÜB_2 nicht leer

blocklänge = i
Else
If IsEmpty(Cells(i - 1, 6)) And IsEmpty(Cells(i, 6)) Then 'zählen der Leerzellen
leerzähler = leerzähler + 1
Else
leerzähler = 1
End If
End If
Wend

start_zeile = start_zeile_old 'rücksetzen

End Function

---------------------------------------------------

Function berechnen(i) As Single

Dim CC0, CC4, CC5, CC6, CC As Single
Dim X0, XX0, XXX0, XXXX0, Y0, YY0, YYY0, YYYY0, Z0, ZZ0, ZZZ0, ZZZZ0, U0, UU0, UUU0, UUUU0, V0, VV0, VVV0, VVVV0, W0, WW0, WWW0, WWWW0, T0, TT0 As String 'Dim oder Public anderene Stellen liefern keine andere Zeitminderungen
Dim X4, XX4, XXX4, XXXX4, Y4, YY4, YYY4, YYYY4, Z4, ZZ4, ZZZ4, ZZZZ4, U4, UU4, UUU4, UUUU4, V4, VV4, VVV4, VVVV4, W4, WW4, WWW4, WWWW4 As String
....usw....

zelle_C = block_C(i, 1) 'Spalte "Position"
zelle_Q = block_Q(i, 1) 'Spalte "Menge"
zelle_B = block_B(i, 1) 'Spalte "Bereich"

X0 = ifi(verketti(zelle_C, ">", 3), "")
XX0 = verketti(zelle_B, "+", zelle_C - 3)
XXX0 = CountIfi(block_D3D3, XX0, stücklilänge)
XXXX0 = verketti(zelle_B, "+", zelle_C - 3, "+", XXX0)
Y0 = SumIfi(block_F3F4, XXXX0, block_Q3Q4, stücklilänge) 'Änderung XXXX0
YY0 = verketti(zelle_B, "+", zelle_C - 2)
YYY0 = CountIfi(block_D3D3, YY0, stücklilänge)
YYYY0 = verketti(zelle_B, "+", zelle_C - 2, "+", YYY0)
Z0 = SumIfi(block_F3F4, YYYY0, block_Q3Q4, stücklilänge)
ZZ0 = verketti(zelle_B, "+", zelle_C - 1)
ZZZ0 = CountIfi(block_D3D3, ZZ0, stücklilänge)
ZZZZ0 = verketti(zelle_B, "+", zelle_C - 1, "+", ZZZ0)
W0 = SumIfi(block_F3F4, ZZZZ0, block_Q3Q4, stücklilänge)
WW0 = ifi(verketti(zelle_C, "=", 3), W0 * Z0 * Y0 * zelle_Q, X0)
WWW0 = YY0
WWWW0 = CountIfi(block_D3D3, WWW0, stücklilänge)
U0 = verketti(zelle_B, "+", zelle_C - 2, "+", WWWW0)
UU0 = SumIfi(block_F3F4, U0, block_Q3Q4, stücklilänge)
UUU0 = ZZ0
UUUU0 = CountIfi(block_D3D3, UUU0, stücklilänge)
V0 = verketti(zelle_B, "+", zelle_C - 1, "+", UUUU0)
VV0 = SumIfi(block_F3F4, V0, block_Q3Q4, stücklilänge)
VVV0 = ifi(verketti(zelle_C, "=", 2), VV0 * UU0 * zelle_Q, WW0)
VVVV0 = verketti(zelle_B, "+", zelle_C - 1, "+1")
T0 = SumIfi(block_F3F4, VVVV0, block_Q3Q4, stücklilänge)
TT0 = ifi(verketti(zelle_C, "=", 1), T0 * zelle_Q, VVV0)
CC0 = ifi(verketti(zelle_C, "=", 0), zelle_Q, TT0)
...usw...

ergebnisse(zeilenzähler, 1) = CC0 + CC4 + CC5 + CC6
allesber = allesber + 1 'nur zu Testzwecken

End Function

---------------------------------------------------

Function verketti(Optional ByVal a As String, Optional ByVal b As String, Optional ByVal c As String, Optional ByVal d As String, Optional ByVal e As String, Optional ByVal f As String) As String

verketti = a & b & c & d & e & f

End Function

---------------------------------------------------

Function ifi(ByVal a As String, ByVal b As String, Optional ByVal c As String) As String

'nur für die Vergleichsoperatoren = < > geschrieben
'es muss immer schon der Vergleichswert als String übergeben werden z.B. anstatt C3=5 range("C3").value=123 also "123=5"

Dim ii As Integer
Dim a1 As String
Dim a2 As String
Dim b1 As String
Dim c1 As String
Dim operatorx As String

a1 = "mülli"

For ii = 1 To Len(a)
parse = Mid(a, ii, 1)
If (parse = "=") Or (parse = ">") Or (parse = "<") Then
a1 = Left(a, ii - 1)
a2 = Right(a, Len(a) - ii)
a1 = Trim(a1)
a2 = Trim(a2)
operatorx = Mid(a, ii, 1)
End If
Next

If a1 = "mülli" Then
MsgBox "Der Allgorithmus wurde nur für die Vergleichsoperatoren = < > geschrieben! Die Werte werden nicht korrekt berechnet!"
End If

ActiveSheet.Select

Select Case operatorx

Case "="
If a1 = a2 Then
ifi = b
Else
ifi = c
End If

Case "<"
If a1 < a2 Then
ifi = b
Else
ifi = c
End If

Case ">"
If a1 > a2 Then
ifi = b
Else
ifi = c
End If

End Select

End Function

---------------------------------------------------

Function CountIfi(block As Variant, ByVal vergleich As String, Optional ByVal bis As Long) As Long
Dim zählerif As Long
zählerif = 0
For i = 1 To bis

If block(i, 1) = vergleich Then
zählerif = zählerif + 1
End If
Next
CountIfi = zählerif
End Function

---------------------------------------------------

Function SumIfi(block As Variant, ByVal vergleich As String, block2 As Variant, Optional ByVal bis As Long) As Long
Dim sumif As Long
sumif = 0
For iii = 1 To bis

If block(iii, 1) = vergleich Then
sumif = sumif + block2(iii, 1)
End If
Next
SumIfi = sumif
End Function

---------------------------------------------------

Function writeback()
For i = start_zeile To blocklänge

Cells(i, ergebnisspalte).Value = ergebnisse(i, 1)

Next
End Function

 nach oben

Beiträge aus den Excel-Beispielen zum Thema "WENN-Funktion verschachteln"