Ein Tag hat 24 Stunden. Eine Palette Bier hat 24 Dosen. Das kann kein Zufall sein!
Hallo René,
du bist ein Ass, danke, nun weiß ich wie man die einzelnen Elemente anspricht, nach Zeile und Spalte und habe meinen Code angepasst.
aber: in meinem Fall markiere ich ja vor Eingabe der UDF wie immer bei Matrixfunktionen 3 Zellen untereinander und möchte, dass 3 Ergebnisse aus einem neuen Array, das mit den gewonnenen Variablen arbeitet erscheint
Hallo Axel,
Ich habe die Array verkleinert … das Überwachungsfenster hat mir verraten, dass Matrix1(0, x) und Matrix2(0,x) nicht belegt sind.
Public Function Test1(S1 As Variant, R1 As Variant, S2 As Variant, R2 As Variant, R3 As Variant)
' Funktionsbeschreibung: Berechnet den Schnittpunkt einer Geraden mit einer Ebene,
' Inputselektion: 5 zusammenhŠngende Zellbereiche (S1,R1,S2,R2,R3)
' Variablen deklarieren
Dim S1x As Double
Dim S1y As Double
Dim S1z As Double
Dim R1x As Double
Dim R1y As Double
Dim R1z As Double
Dim S2x As Double
Dim S2y As Double
Dim S2z As Double
Dim R2x As Double
Dim R2y As Double
Dim R2z As Double
Dim R3x As Double
Dim R3y As Double
Dim R3z As Double
Dim x1 As Double
Dim x2 As Double
Dim x3 As Double
Dim Loesung()
Dim r As Double
Dim ReturnArray(3)
Dim DoTranspose As Boolean
Dim Matrix1(2, 2) As Double ' (kann man das so deklarieren (Anzahl Zeilen/Spalten der Matrix)?
Dim Matrix2(2, 0) As Double
' Bestimmen, ob Inputbereich horizontal oder vertikal ist
If Application.Caller.Rows.Count > 1 Then
DoTranspose = True
Else
DoTranspose = False
End If
' Werte aus Inputselektion (Vektorkoordinaten und neue LŠnge) holen
S1x = S1.Cells(1).Value
S1y = S1.Cells(2).Value
S1z = S1.Cells(3).Value
R1x = R1.Cells(1).Value
R1y = R1.Cells(2).Value
R1z = R1.Cells(3).Value
S2x = S2.Cells(1).Value
S2y = S2.Cells(2).Value
S2z = S2.Cells(3).Value
R2x = R2.Cells(1).Value
R2y = R2.Cells(2).Value
R2z = R2.Cells(3).Value
R3x = R3.Cells(1).Value
R3y = R3.Cells(2).Value
R3z = R3.Cells(3).Value
'Matrizes bestimmen
'3x3 Matrix
Matrix1(0, 0) = R1.Cells(1).Value
Matrix1(1, 0) = R1.Cells(2).Value
Matrix1(2, 0) = R1.Cells(3).Value
Matrix1(0, 1) = R2.Cells(1).Value * (-1)
Matrix1(1, 1) = R2.Cells(2).Value * (-1)
Matrix1(2, 1) = R2.Cells(3).Value * (-1)
Matrix1(0, 2) = R3.Cells(1).Value * (-1)
Matrix1(1, 2) = R3.Cells(2).Value * (-1)
Matrix1(2, 2) = R3.Cells(3).Value * (-1)
'1x1 Matrix
Matrix2(0, 0) = S2.Cells(1).Value - S1.Cells(1).Value
Matrix2(1, 0) = S2.Cells(2).Value - S1.Cells(2).Value
Matrix2(2, 0) = S2.Cells(3).Value - S1.Cells(3).Value
' Berechnungen
' r berechnen
Loesung = Application.WorksheetFunction.MMult(Application.WorksheetFunction.MInverse(Matrix1), Matrix2)
r = Loesung(1, 1)
MsgBox r
' Ergebnis berechnen (Koordinaten des Schnittpunkts nder Geraden mit der Ebene)
ReturnArray(0) = S1x + r * R1x
ReturnArray(1) = S1y + r * R1y
ReturnArray(2) = S1y + r * R1y
' Output transponieren horizontal zu vertikal oder umgekehrt, falls n_tig
If DoTranspose Then
Test1 = Application.WorksheetFunction.Transpose(ReturnArray)
Else
Test1 = ReturnArray
End If
' Ergebnis erscheint in den 3 Output-Zellen
End Function
was habe ich gestern gemacht? Wir haben ja herausgefunden, dass in der „Lösungs“-Zeile der Fehler steckt.
Ich habe das Datenfeld Matrix markiert und das Überwachungsfenster eingeschaltet. Dort habe ich festgestellt, dass der Wert an der Position 0 nicht belegt ist: