Keine "geeignete" Lösung gefunden ... soso - zu höhe Ansprüche? ;)
Naja, dann probier mal:
Option Explicit
'////////////////////////////////////////////////////////////////
Const E_KRONECKERPROD_INVALID_ARG As Long = XlCVError.xlErrRef
'////////////////////////////////////////////////////////////////
'////////////////////////////////////////////////////////////////
'//
Public Sub TestRun()
Dim result As Variant
Dim retVal As Variant
With Worksheets("Tabelle1")
retVal = KroneckerProd(.Range("B2:L12"), .Range("O2:Y12"), result)
If Not IsError(retVal) Then
'output
.Range("B15").Resize(UBound(result), UBound(result, 2)).Value = result
Else
Select Case CLng(retVal)
Case E_KRONECKERPROD_INVALID_ARG
Call MsgBox("invalid argument(s)", vbCritical)
Case Else
Call MsgBox(CStr(retVal), vbCritical)
End Select
End If
End With
End Sub
'////////////////////////////////////////////////////////////////
'//
Public Function KroneckerProd(ArgA As Variant, ArgB As Variant, ByRef RetArg As Variant) As Variant
Dim vA, vB
On Error Resume Next
vA = ArgA: vB = ArgB
On Error GoTo 0
If IsArray(vA) And IsArray(vB) Then
ReDim RetArg(1 To (UBound(vA) - LBound(vA) + 1) * (UBound(vB) - LBound(vB) + 1), _
1 To (UBound(vA, 2) - LBound(vA, 2) + 1) * (UBound(vB, 2) - LBound(vB, 2) + 1))
KroneckerProd = KroneckerProd__(vA, vB, RetArg)
If IsEmpty(KroneckerProd) Then KroneckerProd = 0
Else
KroneckerProd = CVErr(E_KRONECKERPROD_INVALID_ARG)
End If
End Function
'////////////////////////////////////////////////////////////////
'//
Private Function KroneckerProd__(ArgA As Variant, ArgB As Variant, ByRef ArgC As Variant, Optional Idx1, Optional Idx2) As Variant
Dim i&, j&, m&, n&
If IsArray(ArgA) And IsArray(ArgB) Then
If Not (IsMissing(Idx1) Or IsMissing(Idx2)) Then
m = (UBound(ArgB) - LBound(ArgB) + 1)
n = (UBound(ArgB, 2) - LBound(ArgB, 2) + 1)
For i = 1 To m
For j = 1 To n
ArgC(i + (Idx1 - 1) * m, j + (Idx2 - 1) * n) = ArgA(Idx1, Idx2) * ArgB(i, j)
Next j, i
Else
For i = 1 To UBound(ArgA) - LBound(ArgA) + 1
For j = 1 To UBound(ArgA, 2) - LBound(ArgA, 2) + 1
Call KroneckerProd__(ArgA, ArgB, ArgC, i, j)
Next j, i
End If
Else
KroneckerProd__ = CVErr(E_KRONECKERPROD_INVALID_ARG)
End If
End Function
|