Voraussichtl Schlussbeitrag mit UDF Layers
25.11.2020 02:21:12
Luc:?
Die bereits zu Anfang in Fmln gezeigte UDF Layers kann ja auf 3erlei Weise eingesetzt wdn:
1. Anzeige einer einzelnen Ebene, wobei alle Ebenen auch so zusammengesetzt wdn können, dass sich ein GesamtBild ergibt, dass im Falle des sog Kronecker-Produkts allerdings nicht der üblichen MatrixDarstellung desselben entspricht, sondern, wie bereits zuvor erwähnt, dem bei vertauschten FaktorMatrizen. Diese Darstellung wird dadurch erleichtert, dass man für die UDF-Argumente 2 u.3 die relative (Arg2) bzw absolute Adresse (Arg3) der 1.Zelle des wiederzugebenden EbenenGesamtBildes einträgt. Dadurch wird die Ebene bei Fml-Kopie im richtigen Abstand entsprd variiert. Bewegt man sich dabei rückwärts, also von rechts unten nach links oben, wird die Reihenfolge der einzelnen Ebenen umgekehrt. Für die 1.Ebene gilt hierbei nämlich stets Arg2 bezieht sich auf die gleiche Zelle wie Arg3. Dasselbe gilt dann naturgemäß auch für die letzte Ebene. Bezogen auf die QuellDaten im 1.Teil dieses INDEX-Beitrags können die pluralen Start- u/o Schluss-MatrixFmln dann so aussehen:
M110:O114[;P110:R114;M115:R129]: {=Layers(INDEX(WENNFEHLER(INDEX($A$2:$C$6;ZEILE($1:$5);SPALTE($A:$C))*INDEX($A$8:$B$11;;;1^$A$2:$C$6);0);;;1^$A$2:$C$6);M110;$M$110)}
M152:O156[;P152:R156;M157:R171]: {=Layers(INDEX(WENNFEHLER(INDEX($A$2:$C$6;ZEILE($1:$5);SPALTE($A:$C))*INDEX($A$8:$B$11;;;1^$A$2:$C$6);0);;;1^$A$2:$C$6);M152;$P$167)}
2. Es können auch alle Ergebnisse auf einmal zurückgegeben wdn, aber in Form von textlichen MatrixKonstanten über genausoviel Zellen bei gleicher Anordnung wie die 1.FaktorMatrix. Eine solche plurale MatrixFml sähe mit Layers für das Bsp in diesem INDEX-Teil so aus:
O68:Q72: {=Layers(INDEX(INDEX(M41:O45;ZEILE(1:5);SPALTE(A:C))*INDEX(M47:Q49;;;1^M41:O45);;;1^M41:O45);;;1)}
Hierbei wdn die TextForm-MatrixKonstanten in US-OriginalNotation angezeigt, was aber nur erforderlich ist, wenn sie per vbFkt Evaluate oder UDF TensEx in GesamtMatrizen gewandelt wdn sollen. Anderenfalls kann Arg4 ebenfalls entfallen.
3. Wird Argument5 WAHR oder ≠0 gesetzt, erfolgt die Bildung eines Qubix automatisch, wenn die bereits zuvor gezeigten SubProzeduren (inkl EreignisProzedur zum EinsatzBlatt) vorhanden sind. Dabei wird letztlich der MatrixVerbund aufgelöst, da die plurale MatrixFml entfernt wdn muss. Sie wird aber per Kommentar in der 1.Zelle des Qubix' bewahrt, so dass sie ggf zurückgeschrieben wdn kann.
Die nachfolgende UDF benötigt im VBE einen Verweis auf eine DLL, eine hier ebenfalls angegebene Enumeration und ggf die UDF VJoin in Versionen ab 1.4 (volle Leistung erst ab Version 1.5). Je nach Vorhandensein muss (ggf kann) die Konstante für die BedingtKompilierung eingestellt wdn. Standardmäßig ist #Const JoinTyp = 0 (ohne VJoin), bei Vorliegen von VJoin-Vs1.4 kann auf -1, ab Vs1.5 auf 1 gestellt wdn. Die Darstellung von Element-Matrizen ist nur ab Vs1.5 möglich, anderenfalls wdn Element-Vektoren verwendet, was für den Anwendungsfall Tabellen-Obfuskation auch ausreichend sein sollte.
Option Explicit
Public Enum cxTriState: cxAsUsed = -2: cxTrue: cxFalse: cxCTrue: End Enum
Rem Ptm#0: Unterstützg/Fixierg quasi 3-4dimensionaler DatenfeldMatrizen (3-4stufige Tensoren)
' [Fmln m.xlFkt INDEX können im Ergebn uU 3-4dimens DFelder liefern, aber diese weder voll-
' ständig indizieren noch abbild. Solche Daten können aber zwecks Auswertbark fixiert wdn.]
' Arg1: spez INDEX-Fml, die ein 3/4d-Dfeld (Qubix) erzeugt; Arg2: Qubix-ZeilenTensorNr oder
' linke obere Zelle d.akt ErgebBereichs (relativ) bzw entfällt; Arg3: Qubix-SpaltenTensorNr
' linke ob Zelle d.PrimärErgebBereichs (absolut) bzw entfällt; Arg4: fehlt/0/FALSCH MxKonst
' d.Ergebnisses wird in Lokal-, andfalls in US-OrigForm erzeugt; Arg5: fehlt/0/FALSCH Ergeb
' wird nicht, sonst automat gestapelt (m.benöt Subproz BuildQStack per Ruf aus EreignProz).
' Hwss: UDF zeigt im AutoStapelModus statt Ergebniss RhfolgNrn d.Berechn u.ZellAdressen an;
' fehlen Argg2/3, wdn alle vorhd/erzeugten Daten zellweise in MxKonsttForm zusammengefasst,
' wobei jede Zelle uU in willkürlicher Rhfolge einzeln berechnet wird (Effekt d.spez INDEX-
' MxFml unter Xl), andfalls wird d.entsprd Qubix-Ebene wiedgegeben bzw aus d.ZellAngaben lt
' Versatz Argg2:3 ermittelt, wobei ds auch rückwärts erfolg kann (in bd Argg2/3-Varianten).
' Im Ggsatz zur UDF TensEx in akt Vs1.3, die zZ nur sowohl ALLE Matrizen als auch ALLE Ebe-
' nen eines berechneten Qubix exten- bzw -pandieren kann, stellt Layers nur einzelne Ebenen
' dar, deren Fmln so platziert wdn könn, dass sich 1e GesamtMatrix ergibt, die in Bezug auf
' d.Kronecker-MxProdukt d.klass ErgebnisBild b.Vertauschen beider FaktorMatrizen entspricht
' (seine Xl-AbbEbenen u.math TeilMatrizen stehen generell in diesem Vhältn zueinander). Die
' 1.FaktorMatrix bestimmt in Xl stets d.Größe d.ErgebnisBereichs u.damit d.Qubix-Ebenen, so
' dass d.Abbild aller (Ergeb-)Werte (Argg2/3 entfall) so nur als MxKonstt fixiert mögl ist;
' außerd kann d.UDF im Ggsatz zu TensEx d.Ebenen nur aus d.DirektErgeb d.BildFml ermitteln!
' Mit UDF TensQubix lässt sich quasi umgekehrt 1e GesamtMatrix ebfalls in Qubix-Form bring.
' Achtg! Benötigt Enum cxTriState, Dictionary (Vws auf Scripting Runtime) u.regul UDF VJoin
' (#Const JoinTyp=-1/1 Vs1.4/Vss >1.4, =0 ohne VJoin bedingt kompiliert ->4d-Qubix nur b.1,
' VJoin ab Vs1.5, möglich, sonst stets nur als 3d-Qubix angelegt); bedient 3 GlobVariablen.
' Vs1.3 -LSr -cd:20200724 -1pub:nie -lupd:20201001n
Function Layers(Bezug, Optional ByVal ZTensOrAktEZelle, Optional ByVal STensOrPrimEZelle, _
Optional ByVal nLokJoin As Boolean, Optional ByVal alsStapel As Boolean)
#Const JoinTyp = 0
Static dlZ As Long
Dim cc As Long, cfc(1) As Long, cl(1) As Long, cx As Long, px As Long, _
rc As Long, rfc(1) As Long, rl(1) As Long, rx As Long, isAll(1) As Boolean, _
isQubix As cxTriState, adAZ$, mxCSep$(), mxLBrc$(), mxRBrc$(), mxRSep$(), _
erg, xBez, xp, zwErg As Variant, wf As WorksheetFunction
On Error Resume Next
If IsError(LBound(Bezug, 2)) Then
cc = UBound(Bezug) + 1 - LBound(Bezug): rc = 1
Else: cc = UBound(Bezug, 2) + 1 - LBound(Bezug, 2)
rc = UBound(Bezug, 1) + 1 - LBound(Bezug, 1)
End If
On Error GoTo fx: Set wf = WorksheetFunction
If TypeOf Bezug Is Range Then Err.Raise xlErrRef
With Application
adAZ = .ThisCell.Address(0, 0)
mxLBrc = Split(.International(xlLeftBrace) & " {")
mxRBrc = Split(.International(xlRightBrace) & " }")
mxCSep = Split(.International(xlColumnSeparator) & " ,")
mxRSep = Split(.International(xlRowSeparator) & " ;")
End With
isQubix = CInt(IsMissing(ZTensOrAktEZelle)) Xor 2 * CInt(IsMissing(STensOrPrimEZelle))
alsStapel = alsStapel And isQubix = cxFalse
If alsStapel And dStap Is Nothing Then Set dStap = CreateObject("Scripting.Dictionary")
On (isQubix + 3 Xor 7) Mod 4 GoTo av, ak, em
If TypeOf ZTensOrAktEZelle Is Range And TypeOf STensOrPrimEZelle Is Range Then
If alsStapel Then
cl(1) = STensOrPrimEZelle.Columns.Count: rl(1) = ZTensOrAktEZelle.Rows.Count
adQPZ = Cells(ZTensOrAktEZelle.Row, STensOrPrimEZelle.Column).Address(0, 0)
Else: cfc(0) = STensOrPrimEZelle.Column: rfc(0) = STensOrPrimEZelle.Row
cfc(1) = ZTensOrAktEZelle.Column: cl(0) = Abs(cfc(1) - cfc(0)) \ cc
rfc(1) = ZTensOrAktEZelle.Row: rl(0) = Abs(rfc(1) - rfc(0)) \ rc
End If
ElseIf IsArray(ZTensOrAktEZelle) Or IsArray(STensOrPrimEZelle) Then
av: If IsArray(STensOrPrimEZelle) Then
If LBound(STensOrPrimEZelle) = UBound(STensOrPrimEZelle) Then
STensOrPrimEZelle = STensOrPrimEZelle(UBound(STensOrPrimEZelle)): GoTo sn
Else: On Error Resume Next
If IsError(LBound(STensOrPrimEZelle, 2)) Then
cl(Abs(alsStapel)) = wf.Index(STensOrPrimEZelle, 1 - CInt(alsStapel))
If alsStapel Then cfc(1) = wf.Index(STensOrPrimEZelle, 1)
Else: cl(Abs(alsStapel)) = wf.Index(STensOrPrimEZelle, 1 - CInt(alsStapel), 1)
If alsStapel Then cfc(1) = wf.Index(STensOrPrimEZelle, 1, 1)
End If
On Error GoTo fx
End If
Else
sn: If IsNumeric(STensOrPrimEZelle) Then
If alsStapel And CBool(InStr(STensOrPrimEZelle, " ")) Then
cl(1) = CLng(Split(STensOrPrimEZelle)(1))
cfc(1) = CLng(Split(STensOrPrimEZelle)(0))
Else: cl(0) = STensOrPrimEZelle
End If
Else: Err.Raise xlErrNum
End If
End If
On Abs(isQubix) GoTo ev
ak: If IsArray(ZTensOrAktEZelle) Then
If LBound(ZTensOrAktEZelle) = UBound(ZTensOrAktEZelle) Then
ZTensOrAktEZelle = ZTensOrAktEZelle(UBound(ZTensOrAktEZelle)): GoTo zn
Else: On Error Resume Next
If IsError(LBound(ZTensOrAktEZelle, 2)) Then
rl(Abs(alsStapel)) = wf.Index(ZTensOrAktEZelle, 1 - CInt(alsStapel))
If alsStapel Then rfc(1) = wf.Index(ZTensOrAktEZelle, 1)
Else: rl(Abs(alsStapel)) = wf.Index(ZTensOrAktEZelle, 1 - CInt(alsStapel), 1)
If alsStapel Then rfc(1) = wf.Index(ZTensOrAktEZelle, 1, 1)
End If
On Error GoTo fx
End If
Else
zn: If IsNumeric(ZTensOrAktEZelle) Then
If alsStapel And CBool(InStr(ZTensOrAktEZelle, " ")) Then
rl(1) = CLng(Split(ZTensOrAktEZelle)(1))
rfc(1) = CLng(Split(ZTensOrAktEZelle)(0))
Else: rl(0) = ZTensOrAktEZelle
End If
Else: Err.Raise xlErrNum
End If
End If
If alsStapel Then _
adQPZ = Cells(rfc(1), cfc(1)).Address(0, 0): cfc(1) = 0: rfc(1) = 0
On (2 + isQubix) Mod 2 + 1 + CInt(alsStapel) GoTo ek, ev
ElseIf IsNumeric(ZTensOrAktEZelle) And IsNumeric(STensOrPrimEZelle) Then
If alsStapel Then
cl(1) = InStr(STensOrPrimEZelle, " ")
rl(1) = InStr(ZTensOrAktEZelle, " ")
If CBool(rl(1) * cl(1)) Then
cl(1) = CLng(Split(STensOrPrimEZelle)(1))
rl(1) = CLng(Split(ZTensOrAktEZelle)(1))
adQPZ = Cells(CLng(Split(ZTensOrAktEZelle)(0)), _
CLng(Split(STensOrPrimEZelle)(0))).Address(0, 0)
Else: Err.Raise xlErrRef
End If
Else: cl(0) = STensOrPrimEZelle: rl(0) = ZTensOrAktEZelle
ek: Let isAll(0) = rl(0) = 0: rl(0) = rl(0) - Sgn(rl(0)) * rc ^ Abs(rl(0) = cc Or rl(0) = rc) And _
Not alsStapel Then Err.Raise xlErrNum
End If
Else: Err.Raise xlErrNum
End If
If isQubix = cxTrue Then
ReDim sVk(cc - 1), sKv(rc - 1)
For px = 0 To cc - 1: sVk(px) = sKv: Next px
Else
em: ReDim sVk(rc - 1), sKv(cc - 1)
For px = 0 To rc - 1: sVk(px) = sKv: Next px
End If
zwErg = sVk
For Each xBez In Bezug
If Not IsEmpty(xBez) Then
If isQubix = cxTrue Then zwErg(cx)(rx) = xBez Else zwErg(rx)(cx) = xBez
End If
rx = (rx + 1) Mod rc: cx = (cx - CInt(rx = 0)) Mod cc
Next xBez
If alsStapel Then isQubix = cxCTrue
If isQubix = cxFalse Then
erg = zwErg(rl(0))(cl(0))
Else
#If JoinTyp = 1 Then
Select Case isQubix
Case cxTrue: If isAll(1) Then erg = VJoin(zwErg, mxRSep(Abs(nLokJoin)), cxMaxi) _
Else erg = VJoin(zwErg(cl(0)), mxRSep(Abs(nLokJoin)), cxMaxi)
Case cxAsUsed: If isAll(0) Then erg = VJoin(zwErg, mxCSep(Abs(nLokJoin)), cxMaxi) _
Else erg = VJoin(zwErg(rl(0)), mxCSep(Abs(nLokJoin)), cxMaxi)
Case cxCTrue: If nLokJoin Then erg = VJoin(zwErg, "", cxMaxi) _
Else erg = VJoin(zwErg, , cxMaxi)
End Select
#ElseIf JoinTyp = -1 Then
If isQubix = cxCTrue Then isQubix = cxAsUsed
Select Case isQubix
Case cxTrue: If isAll(1) Then erg = mxLBrc(Abs(nLokJoin)) & VJoin(zwErg, _
mxRSep(Abs(nLokJoin)), -2) & mxRBrc(Abs(nLokJoin)) _
Else: erg = mxLBrc(Abs(nLokJoin)) & VJoin(zwErg(cl(0)), _
mxRSep(Abs(nLokJoin)), -2) & mxRBrc(Abs(nLokJoin))
Case cxAsUsed: If isAll(0) Then erg = mxLBrc(Abs(nLokJoin)) & VJoin(zwErg, _
mxCSep(Abs(nLokJoin)), -2) & mxRBrc(Abs(nLokJoin)) _
Else erg = mxLBrc(Abs(nLokJoin)) & VJoin(zwErg(rl(0)), _
mxCSep(Abs(nLokJoin)), -2) & mxRBrc(Abs(nLokJoin))
End Select
#Else
If isQubix = cxCTrue Then isQubix = cxAsUsed
Select Case isQubix
Case cxTrue: erg = mxLBrc(Abs(nLokJoin)) & Join(zwErg(cl(0)), _
mxRSep(Abs(nLokJoin))) & mxRBrc(Abs(nLokJoin))
Case cxAsUsed: erg = mxLBrc(Abs(nLokJoin)) & Join(zwErg(rl(0)), _
mxCSep(Abs(nLokJoin))) & mxRBrc(Abs(nLokJoin))
End Select
#End If
End If
If alsStapel Then
If Not IsEmpty(erg) Then
If dStap.Exists(adAZ) Then
If dStap.Item(adAZ) erg Then dStap.Item(adAZ) = erg
Else: dStap.Add adAZ, erg
End If
Layers = CStr(dlZ + 1) & "/" & dStap.Keys(dlZ)
End If
dlZ = (dlZ + 1) Mod (rl(1) * cl(1))
If dlZ = 0 Then _
isNonLocal = nLokJoin: adQPZ = Range(adQPZ).Resize(rl(1), cl(1)).Address(0, 0)
Else: Layers = erg
End If
GoTo ex
fx: Layers = CVErr(Err.Number): Set dStap = Nothing: isQubix = vbFalse: isNonLocal = False
erg = Empty: zwErg = Empty: dlZ = 0
ex: Set wf = Nothing
End Function
Ausblick Nutzungsmöglichkeiten:
Abgesehen mal davon, dass das Kronecker-Produkt in klassischer Anwendung eine Möglichkeit bieten könnte, komplexe SpeicherStrukturen zu vereinfachen, worauf ich bereits früher hingewiesen und verlinkt hatte, bestünde in Xl die Möglichkeit, komplexe Tabellen aufzubauen. Da das auf Grund der 2007 vorgenommenen Erweiterung eher kaum noch real erforderlich wäre, käme ggf aber eine Archivierungskomprimierung infrage. Auf der anderen Seite bieten sich so Möglichkeiten, Tabellen unabhängig von gängigen Verschlüsselungsmethoden, ggf auch zusätzlich, zu obfuszieren, d.h. konkret, die echten Daten in einem Stapel erfundener Daten zu verstecken. Das könnte man wohl auch automatisieren und dabei einen Positionscode für die Echtdaten mitschreiben bzw vorgeben, der dem DatenErzeuger und ihrem rechtmäßigen Verwender natürlich bekannt sein muss, aber sonst niemandem. Ich habe es noch nicht ausprobiert, aber evtl kann man die für jedes Element der 1.FaktorMatrix des Kronecker-Produkts wiederholte 2.FaktorMatrix bei jeder Wiederholung etwas anders modifizieren, so dass auch die Bildung der BlindDaten automatisierbar wäre.
Nutzungshinweis:
Meine im Rahmen dieses und anderer Foren veröffentlichten VBA-Prozeduren stehen nach den Regeln des jeweiligen Forums zur Nachnutzung wie geschrieben frei. Nicht erwünscht ist ihre Umbenennung, jedwede Veränderungen außer den vorgesehenen und Anpassungen an spezielle EinsatzFälle. Das ist vor allem bei den UDFs, die mit originären Xl-Fktt weitgehendst zusammenarbeiten können, auch nicht erforderlich. Nicht nur eine Frage der Fairness ist es, die ggf vorangestellten Anmerkungen nicht zu löschen bzw die Zeile mit Versions- u.UrheberVermerk nicht zu entfernen. Keine Einwände wdn gegen die bsphafte Nutzung von PgmTeilen für andere Zwecke erhoben, sofern dafür nicht der gleiche Name verwendet wird. Dann ist natürlich auch erlaubt, dass der jeweilige GesamtAutor seinen eigenen Namen verwendet. Ein Hinweis auf die ursprüngliche Quelle wäre nett, ist aber nicht unbedingt erforderlich (außer bei KomplettÜbernahmen mit nur geringfügigen Änderungen).
Wdn Fehler in den PgmAbläufen konstatiert, die nicht aus falscher Nutzung resultieren, können mir diese im Forum mitgeteilt wdn. Gleiches gilt für evtl Nachfragen. Für ggf durch Nutzung der Prozeduren entstandene Schäden haften weder Autor noch Forumsbetreiber. Meist dürften diese ja auch auf falscher Anwendung beruhen.
Viel Erfolg! Luc :-?