Oha, dann habe ich mich wohl gleich doppelt ...
20.09.2016 01:51:05
Luc:-?
…ungenau erinnert, Michael;
Das sind ja SubProzeduren und keine UDFs und außerdem von Nepumuk. Und ich hätte schwören können, eine UDF von PH mit gleich 6 Möglichkeiten gesehen zu haben (auf XLAM.ch ist wohl eine UDF, allerdings nur zum Ersatz von MTRANS). Dann muss ich wohl doch mal Reflect rausrücken (2 kennen sie ja schon):
Public Enum cxMxRefLevel: cxDiagDown: cxDiagUp: cxVert: cxHoriz: End Enum
Public Enum xlTriState: xlTrue = -1: xlFalse: xlCTrue: End Enum
Rem Spiegelt quadrat Matrix an Diagonalen oder AnfangsReihen bzw transponiert
' nichtquadr Matrix analog; enthält PgmTeile, die nur b.Aufruf aus SubProz,
' nicht in ZellFmln relevant wdn! Benötigt Enums cxMxRefLevel u.xlTriState!
' 1zl/sp Matrizz wdn in 1dim Vektt gewandelt: hV={1.2.3}, vV={{1};{2};{3}}!
' Intuitive Symbole f.Arg2 lt Const txRefEb neben cxMxRefLevel=0
3 möglich!
' Vs1.3 -LSr -cd:20130504 -1pub:20160920 -lupd:20140207n
Function Reflect(ByVal Bezug, Optional ByVal ReflEbene)
Const txRefEb$ = "d dd du v h q qf qs s w \ \ / | _ d df ds"
Dim isRange As Boolean, isElVec As xlTriState, refEb As cxMxRefLevel, _
cn As Long, cx As Long, rn As Long, rx As Long, tmLim(1, 1), _
avBez, elBez, elVec, tmVecL, tmVecU As Variant
On Error GoTo fx
If Not IsMissing(ReflEbene) Then
If IsNumeric(ReflEbene) Then
refEb = Abs(ReflEbene) Mod 4
Else: refEb = WorksheetFunction.Match(ReflEbene, Split(txRefEb), 0) - 1
If refEb UBound(tmVecU, 1) Then
On Error GoTo fx: Err.Raise xlErrRef
Else: On Error GoTo fx
isElVec = Abs(LBound(tmVecL, 2) = UBound(tmVecL, 2))
If isElVec = xlFalse Then Err.Raise xlErrRef
rn = UBound(tmVecL, 1) + 1 - LBound(tmVecL, 1)
End If
Else: rn = 1
End If
ElseIf tmLim(0, 1) = tmLim(1, 1) Then
rn = tmLim(1, 0) + 1 - tmLim(0, 0)
If IsArray(tmVecL) Or IsArray(tmVecU) Then
On Error Resume Next
If IsError(LBound(tmVecL, 2)) And IsError(LBound(tmVecU, 2)) Then
On Error GoTo fx
isElVec = CInt(UBound(tmVecL) = UBound(tmVecU))
If isElVec = xlFalse Then Err.Raise xlErrRef
cn = UBound(tmVecL) + 1 - LBound(tmVecL)
Else: On Error GoTo fx: Err.Raise xlErrRef
End If
Else: cn = 1
End If
Else
If IsArray(Bezug(tmLim(0, 0), tmLim(0, 1))) Or _
IsArray(Bezug(tmLim(1, 0), tmLim(1, 1))) Then Err.Raise xlErrRef
cn = tmLim(1, 1) + 1 - tmLim(0, 1): rn = tmLim(1, 0) + 1 - tmLim(0, 0)
End If
Else: cn = Bezug.Columns.Count: rn = Bezug.Rows.Count
End If
If refEb Switch(isElVec = xlCTrue, rn, _
isElVec = xlTrue, cn) + 1 - LBound(elBez) Then Exit For
ElseIf CBool(isElVec) Or IsArray(elBez) Then
Exit For
End If
End If
If CBool(isElVec) Then
If isElVec = xlTrue Then cx = 0 Else rx = 0
For Each elVec In elBez
GoSub mx
If isElVec = xlTrue Then cx = cx + 1 Else rx = rx + 1
Next elVec
If isElVec = xlCTrue Then cx = cx + 1 Else rx = rx + 1
Else
mx: Select Case refEb
Case cxDiagDown: avBez(cx, rx) = elBez
Case cxDiagUp: avBez(cn - cx - 1, rn - rx - 1) = elBez
Case cxVert: avBez(rx, cn - cx - 1) = elBez
Case cxHoriz: avBez(rn - rx - 1, cx) = elBez
End Select
If CBool(isElVec) Then Return
If isRange Then
cx = (cx + 1) Mod cn: rx = rx - CInt(cx = 0)
Else: rx = (rx + 1) Mod rn: cx = cx - CInt(rx = 0)
End If
End If
Next elBez
If IsEmpty(elBez) Then Reflect = avBez Else Err.Raise xlErrRef
On Error Resume Next
If IsError(LBound(avBez, 2)) Then
Err.Number = 0
Else: On Error GoTo fx: cx = 0: rx = 0
If UBound(avBez, 1) = 0 And UBound(avBez, 2) > 0 Then
ReDim avBez(UBound(avBez, 2) - LBound(avBez, 2))
For Each elBez In Reflect
avBez(cx) = elBez: cx = cx + 1
Next elBez
ElseIf UBound(avBez, 1) > 0 And UBound(avBez, 2) = 0 Then
ReDim avBez(UBound(avBez, 1) - LBound(avBez, 1)), elVec(0)
For Each elBez In Reflect
elVec(0) = elBez: avBez(rx) = elVec: rx = rx + 1
Next elBez
End If
Reflect = avBez
End If
fx: If CBool(Err.Number) Then
Select Case Err.Number
Case Is xlErrNA: Reflect = CVErr(xlErrNA)
Case Else: Reflect = CVErr(Err.Number)
End Select
End If
End Function
Hätte ich auch noch die beiden anderen Möglichkeiten (mit gleichem Ergebnis → völlige Umkehr der Matrix) einbauen wollen, hätten sie die Intuitiv-Symbole + bzw ×. Aber das hielt ich für überflüssig, da man dann auch 2× Reflect anwenden kann.
Gruß, Luc :-?