PDA

View Full Version : code tweaking



troelsi
05-25-2008, 01:03 AM
Hi

I would like to reduce the time necessary to compute the following module. It's part of a greater project and I have allready improved it substantially. I can't see how to reduce it further.

The code:



Option Base 1
Option Explicit
Global straf As Long
Global minlinie As Long
Sub lagerpfs(linienr() As Variant)
Dim start As Double
start = timer
On Error GoTo errorhandler
Dim i, j, k, l, n As Long
Dim x As Variant
Dim r1 As Range
Dim r2 As Range
Dim linie As Integer
Set r1 = Range("A2:A250")
Set r2 = Range("A2:Q250")
straf = 0
For i = LBound(p) To UBound(p)
For j = 1 To UBound(lagerpf, 2)
lagerpf(i, j) = p(i).InitLager
Next j
Next i
For i = 2 To 7
k = 1
If ordrerind(i) > 0 Then
x = linienr(i)
For j = LBound(x) To UBound(x)
If x(j).AkumTid <= k * 24 Then
l = matchF(x(j).Varenr, r1)
For n = k To UBound(lagerpf, 2)
lagerpf(l, n) = lagerpf(l, n) + x(j).Mangde
Next n
Else
j = j - 1
k = k + 1
For l = LBound(p) To UBound(p)
If p(l).linie = i Then
lagerpf(l, k) = lagerpf(l, k - 1)
End If
Next l
End If
Next j
End If
Next i
If ordrerind(8) > 0 Then
k = 1
x = linienr(1)
For j = LBound(x) To UBound(x)
l = matchF(x(j).Varenr, r1)
If p(l).linie = 8 Then
If x(j).AkumTid <= k * 24 Then
For i = k To UBound(lagerpf, 2)
lagerpf(l, i) = lagerpf(l, i) + x(j).RMangde
Next i
Else
j = j - 1
k = k + 1
For l = LBound(p) To UBound(p)
If p(l).linie = 8 Then
lagerpf(l, k) = lagerpf(l, k - 1)
End If
Next l
End If
End If
Next j
End If

For i = LBound(d) To UBound(d)
With d(i)
l = matchF(.Varenr, r1)
For k = (.Tid) To UBound(lagerpf, 2)
lagerpf(l, k) = lagerpf(l, k) - .Reftsp
Next k
End With
Next i
For k = LBound(lagerpf, 2) To UBound(lagerpf, 2)
For l = LBound(p) To UBound(p)
If lagerpf(l, k) < 0 Then
sumrestordre = sumrestordre + Abs((lagerpf(l, k)))
ElseIf lagerpf(l, k) < p(l).minlager Then
SikHedLagStraf = SikHedLagStraf + p(l).minlager - lagerpf(l, k)
End If
Next l
Next k
If TermUdli < 3 Then Call minmakslager
TimeLager = TimeLager + timer - start
Exit Sub
errorhandler:
straf = 200000
TimeLager = TimeLager + timer - start
End Sub
Sub minmakslager()
Dim k, l, linie As Integer
Dim Minsum(2 To 8) As Single
Dim MaksSum() As Single
Dim minsum2 As Single
ReDim minlager(2 To 8)
ReDim MaksLager(249)
ReDim MaksSum(UBound(p))
For k = LBound(lagerpf, 2) To UBound(lagerpf, 2)
For l = LBound(p) To UBound(p)
linie = p(l).linie
If k < UBound(lagerpf, 2) - 1 Then
If lagerpf(l, k) < Minsum(linie) Then
Minsum(linie) = lagerpf(l, k)
With minlager(linie)
.Mangde = lagerpf(l, k)
.PNr = l
.Tidsperiode = k
End With
End If
End If
If k < UBound(lagerpf, 2) Then
If lagerpf(l, k) > MaksSum(l) Then
MaksSum(l) = lagerpf(l, k)
With MaksLager(l)
.Mangde = lagerpf(l, k)
.Tidsperiode = k
End With
End If
End If
Next l
Next k
minlinie = 0
For k = 2 To 8
With minlager(k)
If .Mangde < minsum2 Then
minsum2 = .Mangde
minlinie = k
End If
End With
Next k
If Not minlinie > 0 Then
TermUdli = 3
End If
End Sub



any suggestions?

thanks!

Bob Phillips
05-25-2008, 04:38 AM
You should give us a clue by stating what the code objective is and a synopsis of what it is doing. I am not going to reverse engineer that lot.