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