Einzelergebnisse aus Subroutine
09.01.2021 12:06:32
AL
ich habe eine Frage zu Subroutinen: Ich habe eine Subroutine namens Quertraeger(), in der mehrere Berechnungen durchgeführt werden. Nun möchte ich aus dieser Subroutine einzelne Ergebnisse auslesen lassen. Grund hierfür ist, dass ich eine einzige Subroutine haben möchte, damit bei Änderung/Anpassung nicht viel Aufwand betrieben werden müsste.
Da meine VBA Kenntnisse bescheiden sind, dachte ich an die Option FUNCTION mit der ich das realisieren könnte. Leider weiß ich aber nicht, wie ich auf Einzelergebnisse der Subroutine zugreifen kann.
Hat jemand eine Idee?
Anbei ein Beispiel FUNCTION mit der ich das Einzelergebnis für P1ox aus Quertraeger() ausgeben möchte:
Public Function P1ox(BA9, BB9, BZA9, BZB9, HTu9, HTo9, beta9, BT9, HTs9, LT9, HSo9, _
XT9, YT9, ZT9 As Double, Art9 As String) As Double
Call Quertraeger(BA9, BB9, BZA9, BZB9, HTu9, HTo9, beta9, BT9, HTs9, LT9, _
HSo9, XT9, YT9, ZT9, Art9)
P1ox = P1ox
End Function
Sub Quertraeger(BA, BB, BZA, BZB, HTu, HTo, beta, BT, HTs, LT, HSo, XT, YT, ZT As Double, Art As String)
Dim BAu, BBu, BAo, BBo, LTx, LTy, x, y, vorz, Pi, beta2, vorz2 As Double
Dim P1ux, P1uy, P1uz As Double
Dim P1ox, P1oy, P1oz As Double
Dim P2ux, P2uy, P2uz As Double
Dim P2ox, P2oy, P2oz As Double
Dim P3ux, P3uy, P3uz As Double
Dim P3ox, P3oy, P3oz As Double
Dim P4ux, P4uy, P4uz As Double
Dim P4ox, P4oy, P4oz As Double
Pi = Application.WorksheetFunction.Pi
BAu = BA + BZA * (HTu - HSo)
BBu = BB + BZB * (HTu - HSo)
BAo = BA + BZA * (HTo - HSo)
BBo = BB + BZA * (HTo - HSo)
If HTu vorz2 = -1
Else
vorz2 = 1
End If
'---Fall beta = 0° oder beta = 180°------------------------------------------------------------------------------------------------------
If (beta = 0 Or beta = 180) Then
Select Case beta
Case 180
vorz = -1
Case 0
vorz = 1
End Select
If Art = "Traverse" Then
'Punktkoordinaten Untergurt Pi,u,j = [ X / Y / Z ]
P1ux = vorz * LT: P2ux = vorz * LT
P1uy = vorz * -BT: P2uy = vorz * BT
P1uz = HTu: P2uz = HTu
'Punktkoordinaten Obergurt Pi,o,j = [ X / Y / Z ]
P1ox = vorz * LT: P2ox = vorz * LT
P1oy = vorz * -BT: P2oy = vorz * BT
P1oz = HTu - vorz2 * HTs: P2oz = HTu - vorz2 * HTs
ElseIf Art = "Erdseilhorn" Then
'Punktkoordinaten Untergurt Pi,u,j = [ X / Y / Z ]
P1ux = XT + vorz * HTs / 2: P2ux = XT + vorz * HTs / 2
P1uy = vorz * (-BT) / 2: P2uy = vorz * BT / 2
P1uz = ZT: P2uz = ZT
'Punktkoordinaten Obergurt Pi,o,j = [ X / Y / Z ]
P1ox = XT - vorz * HTs / 2: P2ox = XT - vorz * (-HTs) / 2
P1oy = vorz * (-BT) / 2: P2oy = vorz * BT / 2
P1oz = ZT: P2oz = ZT
End If
'Punktkoordinaten Untergurt Pi,u,j = [ X / Y / Z ]
P3ux = vorz * BAu / 2: P4ux = vorz * BAu / 2
P3uy = vorz * BBu / 2: P4uy = vorz * (-BBu / 2)
P3uz = HTu: P4uz = HTu
'Punktkoordinaten Obergurt Pi,o,j = [ X / Y / Z ]
P3ox = vorz * BAo / 2: P4ox = vorz * BAo / 2
P3oy = vorz * BBo / 2: P4oy = vorz * (-BBo / 2)
P3oz = HTo: P4oz = HTo
'-------Fall 0° ElseIf ((0 If (0 vorz = 1
beta2 = beta
ElseIf (180 vorz = -1
beta2 = beta - 180
End If
x = Sin(beta2 * Pi / 180) * BT
y = Cos(beta2 * Pi / 180) * BT
LTy = Sin(beta2 * Pi / 180) * LT
LTx = Cos(beta2 * Pi / 180) * LT
'Punktkoordinaten Untergurt Pi,u,j = [ X / Y / Z ]
P1ux = vorz * (LTx + x / 2): P2ux = vorz * (LTx - x / 2): P3ux = vorz * (-BAu / 2): P4ux = vorz * BAu / 2
P1uy = vorz * (LTy - y / 2): P2uy = vorz * (LTy + y / 2): P3uy = vorz * BBu / 2: P4uy = vorz * (-BBu / 2)
P1uz = HTu: P2uz = HTu: P3uz = HTu: P4uz = HTu
'Punktkoordinaten Obergurt Pi,o,j = [ X / Y / Z ]
P1ox = vorz * (LTx + x / 2): P2ox = vorz * (LTx - x / 2): P3ox = vorz * (-BAo / 2): P4ox = vorz * BAo / 2
P1oy = vorz * (LTy - y / 2): P2oy = vorz * (LTy + y / 2): P3oy = vorz * BBo / 2: P4oy = vorz * (-BBo / 2)
P1oz = HTu - vorz2 * HTs: P2oz = HTu - vorz2 * HTs: P3oz = HTo: P4oz = HTo
'---------------Fall beta = 90° oder beta = 270°------------------------------------------------------------------------------------------
ElseIf (beta = 90 Or beta = 270) Then
Select Case beta
Case 270
vorz = -1
Case 90
vorz = 1
End Select
'Punktkoordinaten Untergurt Pi,u,j = [ X / Y / Z ]
P1ux = vorz * BT / 2: P2ux = vorz * (-BT / 2): P3ux = vorz * (-BAu / 2): P4ux = vorz * BAu / 2
P1uy = vorz * LT: P2uy = vorz * LT: P3uy = vorz * BBu / 2: P4uy = vorz * BBu / 2
P1uz = HTu: P2uz = HTu: P3uz = HTu: P4uz = HTu
'Punktkoordinaten Obergurt Pi,o,j = [ X / Y / Z ]
P1ox = vorz * BT / 2: P2ox = vorz * (-BT / 2): P3ox = vorz * (-BAo / 2): P4ox = vorz * BAo / 2
P1oy = vorz * LT: P2oy = vorz * LT: P3oy = vorz * BBo / 2: P4oy = vorz * BBo / 2
P1oz = HTu - vorz2 * HTs: P2oz = HTu - vorz2 * HTs: P3oz = HTo: P4oz = HTo
'-------------------Fall 90° ElseIf ((90 If (90 vorz = 1
beta2 = beta - 90
ElseIf (270 vorz = -1
beta2 = beta - 270
End If
x = Cos(beta2 * Pi / 180) * BT
y = Sin(beta2 * Pi / 180) * BT
LTy = Cos(beta2 * Pi / 180) * LT
LTx = Sin(beta2 * Pi / 180) * LT
'Punktkoordinaten Untergurt Pi,u,j = [ X / Y / Z ]
P1ux = vorz * (-LTx + x / 2): P2ux = vorz * (-LTx - x / 2): P3ux = vorz * (-BAu / 2): P4ux = vorz * BAu / 2
P1uy = vorz * (LTy + y / 2): P2uy = vorz * (LTy - y / 2): P3uy = vorz * (-BBu / 2): P4uy = vorz * BBu / 2
P1uz = HTu: P2uz = HTu: P3uz = HTu: P4uz = HTu
'Punktkoordinaten Obergurt Pi,o,j = [ X / Y / Z ]
P1ox = vorz * (-LTx + x / 2): P2ox = vorz * (-LTx - x / 2): P3ox = vorz * (-BAo / 2): P4ox = vorz * BAo / 2
P1oy = vorz * (LTy + y / 2): P2oy = vorz * (LTy - y / 2): P3oy = vorz * (-BBo / 2): P4oy = vorz * BBo / 2
P1oz = HTu - vorz2 * HTs: P2oz = HTu - vorz2 * HTs: P3oz = HTo: P4oz = HTo
End If
End Sub