|
| |
Visual-Basic Einsteiger| Hab jetzt den Button,aber | |  | | Autor: harlald | | Datum: 25.04.02 14:23 |
| aber wenn ich ihn drücke, wird trotzdem nichts in meinem Excel-sheet berechnet.
Was muss ich tun damit mit dem drücken des Buttons, meine Kalkulationen berechnet werden . Ich schicke dir hier meine Codes mit sag mir bitte wie ich ihn richtige einfüge und das ganze zum laufen bringe
Danke
der verzweifelte haraldPrivate Sub CommandButton2_Click()
Form2.Frame1.Visible = True
Form2.Show
End Sub
Function Multivariate()
Dim i As Long, j As Long, k As Long, n As Long, iteration As Long, ii As Long
Cells(6, 6) = "=count(B8:F8)"
iteration = Range("F5").Value
n = Range("F6").Value
Dim Num As Long
ReDim Matrix(n, n) As Double, arr(n, n) As Double
ReDim EigVec(n, n) As Double, transpEigVec(n, n) As Double
ReDim EigVal(n) As Double
ReDim diaMatrix(n, n) As Double
ReDim transpEigVec_diaMatrix(n, n) As Double
ReDim y(iteration, n) As Double, mean(n) As Single, sd(n) As Single, corr(n) As Single
ReDim normnum(n) As Single, Z(n) As Single
Dim p As Single, SumX As Single, sumM As Double, sumS As Double, sumDev As Double
ReDim Matrix2(iteration, n) As Double
ReDim Cov(n, n) As Double, dev(iteration, n) As Double
For i = 1 To n
For j = i To n
Matrix(i, j) = Cells(i + 7, j + 1)
Matrix(j, i) = Matrix(i, j)
Next j
Z(i) = Cells(i + 7, 8)
Next i
Call jacobi(Matrix, n, n, EigVal, EigVec, Num)
For i = 1 To n
For j = i + 1 To n
diaMatrix(i, j) = 0
diaMatrix(j, i) = 0
Next j
diaMatrix(i, i) = Sqr(EigVal(i))
Next i
For i = 1 To n
For j = 1 To n
transpEigVec(i, j) = EigVec(j, i)
Next j
Next i
For i = 1 To n
For j = 1 To n
transpEigVec_diaMatrix(i, j) = _
Application.Index((Application.MMult(diaMatrix, transpEigVec)), i, j)
Next j
Next i
p = 0
For k = 1 To iteration
SumX = 0
For ii = 1 To n
normnum(ii) = gauss()
Next ii
For j = 1 To n
y(k, j) = 0
For i = 1 To n
y(k, j) = y(k, j) + transpEigVec_diaMatrix(i, j) * normnum(i)
Next i
If y(k, j) < Z(j) Then SumX = SumX + 1
Next j
If SumX = n Then p = p + 1
Next k
Cells(14, 5) = p / iteration
For j = 1 To n
sumM = 0
For i = 1 To iteration
sumM = sumM + y(i, j)
Next i
mean(j) = sumM / iteration
Cells(j + 16, 3) = mean(j)
Next j
For j = 1 To n
For i = 1 To iteration
dev(i, j) = y(i, j) - mean(j)
Next i
Next j
For i = 1 To n
For j = 1 To n
sumS = 0
For k = 1 To iteration
sumS = sumS + dev(k, i) * dev(k, j)
Next k
Cov(i, j) = sumS / (iteration - 1)
Next j
sd(i) = Sqr(Cov(i, i))
Cells(i + 16, 4) = sd(i)
Next i
For i = 1 To n
For j = 1 To n
Cells(i + 24, j + 1) = Cov(i, j) / (sd(i) * sd(j))
Next j
Next i
End Function
Sub jacobi(A() As Double, n As Long, NP As Long, D() As Double, V() As Double, NROT As Long)
Dim NMAX As Long, B() As Double, Z() As Double
Dim i As Long, SM As Double, THRESH As Double, G As Double, H As Double
Dim T As Double, THETA As Double, C As Double, S As Double, TAU As Double, j As Long
NMAX = 100
ReDim D(NP)
ReDim V(NP, NP)
ReDim B(NP)
ReDim Z(NP)
Dim IP As Long, IQ As Long
For IP = 1 To n
For IQ = 1 To n
V(IP, IQ) = 0#
Next IQ
V(IP, IP) = 1#
Next IP
For IP = 1 To n
B(IP) = A(IP, IP)
D(IP) = B(IP)
Z(IP) = 0#
Next IP
NROT = 0
For i = 1 To 50
SM = 0#
For IP = 1 To n - 1
For IQ = IP + 1 To n
SM = SM + Abs(A(IP, IQ))
Next IQ
Next IP
If (SM = 0#) Then GoTo 999
If (i <= 4) Then
THRESH = 0.2 * SM / (n ^ 2)
Else
THRESH = 0#
End If
For IP = 1 To n - 1
For IQ = IP + 1 To n
G = 100# * Abs(A(IP, IQ))
If ((i >= 4) And (Abs(D(IP)) + G = Abs(D(IP))) And _
(Abs(D(IQ)) + G = Abs(D(IQ)))) Then
A(IP, IQ) = 0#
ElseIf (Abs(A(IP, IQ)) >= THRESH) Then
H = D(IQ) - D(IP)
If (Abs(H) + G = Abs(H)) Then
T = A(IP, IQ) / H
Else
THETA = 0.5 * H / A(IP, IQ)
T = 1# / (Abs(THETA) + Sqr(1# + THETA ^ 2))
If (THETA <= 0) Then T = -T
End If
C = 1# / Sqr(1 + T ^ 2)
S = T * C
TAU = S / (1# + C)
H = T * A(IP, IQ)
Z(IP) = Z(IP) - H
Z(IQ) = Z(IQ) + H
D(IP) = D(IP) - H
D(IQ) = D(IQ) + H
A(IP, IQ) = 0#
For j = 1 To IP - 1
G = A(j, IP)
H = A(j, IQ)
A(j, IP) = G - S * (H + G * TAU)
A(j, IQ) = H + S * (G - H * TAU)
Next j
For j = IP + 1 To IQ - 1
G = A(IP, j)
H = A(j, IQ)
A(IP, j) = G - S * (H + G * TAU)
A(j, IQ) = H + S * (G - H * TAU)
Next j
For j = IQ + 1 To n
G = A(IP, j)
H = A(IQ, j)
A(IP, j) = G - S * (H + G * TAU)
A(IQ, j) = H + S * (G - H * TAU)
Next j
For j = 1 To n
G = V(j, IP)
H = V(j, IQ)
V(j, IP) = G - S * (H + G * TAU)
V(j, IQ) = H + S * (G - H * TAU)
Next j
NROT = NROT + 1
End If
Next IQ
Next IP
For IP = 1 To n
B(IP) = B(IP) + Z(IP)
D(IP) = B(IP)
Z(IP) = 0#
Next IP
Next i
999
End Sub
Function gauss()
Dim fac As Double, r As Double, V1 As Double, V2 As Double
10 V1 = 2 * Rnd - 1
V2 = 2 * Rnd - 1
r = V1 ^ 2 + V2 ^ 2
If (r >= 1) Then GoTo 10
fac = Sqr(-2 * Log(r) / r)
gauss = V2 * fac
End Function | |
 | Sie sind nicht angemeldet!
Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.
 Einloggen | Neu registrieren |
 |
|
vb@rchiv CD Vol.6 vb@rchiv  Vol.6
Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
Online-Update-Funktion
Entwickler-Vollversionen
u.v.m.Jetzt zugreifen Tipp des Monats  Oktober 2025
Matthias KozlowskiUmlaute konvertierenErsetzt die Umlaute in einer Zeichenkette durch die entsprechenden Doppelbuchstaben (aus ä wird ae, usw.) Neu! sevCommand 4.0 
Professionelle Schaltflächen im modernen Design!
Mit nur wenigen Mausklicks statten auch Sie Ihre Anwendungen ab sofort mit grafischen Schaltflächen im modernen Look & Feel aus (WinXP, Office, Vista oder auch Windows 8), inkl. große Symbolbibliothek. Weitere Infos
|
Sie sind aktuell nicht angemeldet.
