Witam, czy znalazłby się pomocny śmiałek który będzie w stanie pomóc z tymi językami? Ja jestem kompletnie zielony jeśli o to chodzi.. Staram się pomóc swojej dziewczynie na wszelki możliwy sposób;l Panie panowie czy da się zrobić coś z tymi danymi ? Wystarczy to wklepać w program by śmigało czy trzeba coś kombinować dodatkowo i mieszać ?:O
VBA:
Public Sub Econ()
Range("E3").Select ' Select the upper-left output cell
row = 0 ' Current output row offset
A1 = Range("C3").Value ' Get data from input cells
A2 = Range("C4").Value
A3 = Range("C5").Value
A3P = Range("C6").Value
A4 = Range("C7").Value
XLAM = Range("C8").Value
DELT = Range("C9").Value
G = Range("C10").Value
D = Range("C11").Value
AA=DELT^2*A3P/(A2+XLAM*A4*G)
XK=0
For I=1 To 10
RHS=(1.2826+XK)/ORDN(XK)
If RHS > AA Then GoTo 5
XK=XK+0.5
Next I
5 XK=XK-0.5
If XK<0 Then XK=0
N=Fix(((1.2826+XK)/DELT)^2+0.5) ' NOTE: truncate expression
NMIN=N-10
If NMIN<=0 Then NMIN = 1
NMAX = N+10
STEPVAL = 0.5
For I=NMIN To NMAX
XK=0.5
For J=1 To 3
BESTFN=1E+38
If J=2 Then STEPVAL=0.1
If J=3 Then STEPVAL=0.01
6 ARG=-1*XK
A=2*PNORM(ARG)
ARG=DELT*Sqr(I)-XK
P=PNORM(ARG)
H=Sqr((A*A3P+A1+A2*I)/(XLAM*A4*(1/P-0.5)))
B=H*(1/P-0.5+XLAM*H/12)+G*I+D
OBJFN=(A4*XLAM*B+A*A3P/H+XLAM*A3)/(XLAM*B+1)+(A1+A2*I)/H
If OBJFN>BESTFN Then GoTo 7
BESTFN=OBJFN
BESTA=A
BESTP=P
BESTK=XK
BESTH=H
XK=XK+STEPVAL
GoTo 6
7 If J=3 Then GoTo 8
XK=BESTK-STEPVAL
8 Next J
' Write outputs to the worksheet
ActiveCell.Offset(row, 0).Value = I
ActiveCell.Offset(row, 1).Value = BESTK
ActiveCell.Offset(row, 2).Value = BESTH
ActiveCell.Offset(row, 3).Value = BESTA
ActiveCell.Offset(row, 4).Value = BESTP
ActiveCell.Offset(row, 5).Value = BESTFN
row = row + 1
Next I
End Sub
Function ORDN(Z)
ORDN=0.39894228*Exp(-Z*Z/2)
End Function
Function PNORM(X)
Dim C(1 To 7)
C(1)=.319381530
C(2)=-.356563782
C(3)=1.781477937
C(4)=-1.821255978
C(5)=1.330274429
C(6)=.2316419
C(7)=2.506628725
Y=X
If X<0 Then Y=-X
T=1/(1+C(6)*Y)
S=((((C(5)*T+C(4))*T+C(3))*T+C(2))*T+C(1))*T
PNORM=S*Exp(-Y*Y/2)/C(7)
If X>0 Then PNORM=1-PNORM
End Function
Appendix C — Montgomery’s(1982) Program in “Modern” VBA
Option Explicit
Sub Econ()
Dim n As Integer, nmin As Integer, nmax As Integer
Dim row As Integer, j As Integer, i As Integer
Dim a1 As Double, a2 As Double, a3 As Double, a3p As Double
Dim a4 As Double, lambda As Double, delta As Double
Dim aa As Double, k As Double, rhs As Double, g As Double
Dim h As Double, p As Double, besth As Double
Dim besta As Double, bestp As Double, bestfn As Double
Dim arg As Double, a As Double, d As Double, objfn As Double
Dim bestk As Double, b As Double, stepval(1 To 3) As Double
' Clear output cells in case they contain old data
Range("E3", "L200").Clear
' Select the upper-left cell of the output range
Range("E3").Select
row = 0
' Get data from input cells
a1 = Range("C3").Value
a2 = Range("C4").Value
a3 = Range("C5").Value
a3p = Range("C6").Value
a4 = Range("C7").Value
lambda = Range("C8").Value
delta = Range("C9").Value
g = Range("C10").Value
d = Range("C11").Value
aa = delta ^ 2 * a3p / (a2 + lambda * a4 * g)
k = 0
For i = 1 To 10
rhs = (1.2826 + k) / ordn(k)
If rhs > aa Then
Exit For
End If
k = k + 0.5
Next i
k = k - 0.5
If k < 0 Then
k = 0
End If
' FORTRAN converts reals to integers by truncating, but VBA
' rounds. The VBA Fix function truncates like FORTRAN.
n = Fix(((1.2826 + k) / delta) ^ 2 + 0.5)
nmin = n - 10
If nmin <= 0 Then
nmin = 1
End If
nmax = n + 10
stepval(1) = 0.5
stepval(2) = 0.1
stepval(3) = 0.01
For i = nmin To nmax
k = 0.5
For j = 1 To 3
bestfn = 1E+38
Do Until objfn > bestfn
arg = -k
a = 2 * WorksheetFunction.NormSDist(arg)
arg = delta * Sqr(i) - k
p = WorksheetFunction.NormSDist(arg)
h = Sqr((a * a3p + a1 + a2 * i) / _
(lambda * a4 * (1 / p - 0.5)))
b = h * (1/p - 0.5 + lambda*h/12) + g*i + d
objfn = (a4*lambda*b + a*a3p/h + lambda*a3) / _
(lambda*b + 1) + (a1 + a2*i)/h
If objfn <= bestfn Then
bestfn = objfn
besta = a
bestp = p
bestk = k
besth = h
k = k + stepval(j)
End If
Loop
k = bestk - stepval(j)
Next j
' Write outputs to the worksheet
ActiveCell.Offset(row, 0).Value = i
ActiveCell.Offset(row, 1).Value = bestk
ActiveCell.Offset(row, 2).Value = besth
ActiveCell.Offset(row, 3).Value = besta
ActiveCell.Offset(row, 4).Value = bestp
ActiveCell.Offset(row, 5).Value = bestfn
' Format numbers with appropriate precision
ActiveCell.Offset(row, 1).NumberFormat = "0.00"
ActiveCell.Offset(row, 2).NumberFormat = "0.00"
ActiveCell.Offset(row, 3).NumberFormat = "0.0000"
ActiveCell.Offset(row, 4).NumberFormat = "0.0000"
ActiveCell.Offset(row, 5).NumberFormat = "0.00"
row = row + 1
Next i
End Sub
Function ordn(z As Double) As Double
ordn = 0.39894228 * Exp(-z * z / 2)
End Function
FORTRAN:
READ(5,2) A1,A2,A3,A3P,A4,XLAM,DELT,G,D
2 FORMAT(9F8.0)
WRITE(6,3)
3 FORMAT(1H0,3X,'N',5X,'OPTIMUM K',3X,'OPTIMUM H'
&,6X,'ALPHA',5X,'POWER',4X,'COST')
AA=DELT**2*A3P/(A2+XLAM*A4*G)
XK=0.
DO 4 I = 1,10
RHS=(1.2826+XK)/ORDN(XK)
IF(RHS.GT.AA) GO TO 5
4 XK=XK+0.5
5 XK=XK-0.5
IF(XK.LT.0.) XK=0.
N=((1.2826+XK)/DELT)**2+0.5
NMIN=N-10
IF(NMIN.LE.0) NMIN=1
NMAX=N+10
DO 9 I=NMIN,NMAX
XN=I
XK=0.5
STEP=0.5
DO 8 J=1,3
BESTFN=1.0E+38
IF(J.EQ.2) STEP=0.1
IF(J.EQ.3) STEP=0.01
6 ARG=-1.0*XK
A=2.0*PNORM(ARG)
ARG=DELT*SQRT(XN)-XK
P=PNORM(ARG)
H=SQRT((A*A3P+A1+A2*XN)/(XLAM*A4*(1./P-0.5)))
B=H*(1./P-0.5+XLAM*H/12.)+G*XN+D
OBJFN=(A4*XLAM*B+A*A3P/H+XLAM*A3)/(XLAM*B+1.0)
&+(A1+A2*XN)/H
IF(OBJFN.GT.BESTFN) GO TO 7
BESTFN=OBJFN
BESTA=A
BESTP=P
BESTK=XK
BESTH=H
XK=XK+STEP
GO TO 6
7 IF(J.EQ.3) GO TO 8
XK=BESTK-STEP
8 CONTINUE
9 WRITE(6,10) I,BESTK,BESTH,BESTA,BESTP,BESTFN
10 FORMAT(1H ,I4,2(5X,F7.2),3X,2(3X,F7.4),4X,F7.2)
STOP
END
FUNCTION ORDN(Z)
ORDN=0.39894228*EXP(-Z*Z/2)
RETURN
END
FUNCTION PNORM(X)
DIMENSION C(7)
DATA C/.319381530,-.356563782,1.781477937,
&-1.821255978,1.330274429,.2316419,2.506628725/
Y=X
IF(X.LT.0.) Y=-X
T=1./(1.+C(6)*Y)
S=((((C(5)*T+C(4))*T+C(3))*T+C(2))*T+C(1))*T
PNORM=S*EXP(-Y*Y/2)/C(7)
IF(X.GT.0.) PNORM=1.-PNORM
RETURN
END