Versuche in UDF-MatrixFormelFktionalität
27.10.2015 02:33:48
Luc:-?
habe ich im Folgenden mal einige Versuche zu mehrzelligen MatrixFmln dargestellt. Hierzu habe ich u.a. auch 4(+1) UDFs geschrieben, die bsphaft eine einfache elementweise Addition 2er Vektoren (Bereichs-/Datenfeld-Zeile/-Spalte) realisieren. Diese wdn für diese einfache Operation eigentlich nicht benötigt, sollen aber demonstrieren, wie man derartige Operationen in VBA lösen kann. Hierbei habe ich auf die übliche(n) Vorgehensweise(n) verzichtet, weil ich …
1. Alternativen zeigen und …
2. darstellen/simulieren wollte, wie die fktsexterne Xl-Steuerung fktionieren könnte:
A | B | C | D | E | F | G | H | I | J | K | L | M | |
1 | 1 | 15 | 16 | 16 | 16 | 7 | 16 | 16 | 16 | 16 | 16 | 31 | v-Basisformel C1:C10: {=A1:A10+B1:B10} |
2 | 11 | 12 | 23 | 23 | 23 | 17 | 23 | 13 | 23 | 26 | 23 | 28 | D1:D10: {=VPairs(A1:A10;B1:B10;-3)} |
3 | 7 | 13 | 20 | 20 | 20 | 13 | 20 | 14 | 20 | 22 | 20 | 29 | E1:E10: {=AddIt(A1:A10;B1:B10)} |
4 | 10 | 3 | 13 | 13 | 13 | 16 | 13 | 4 | 13 | 25 | 13 | 19 | vV+Ew F1:F10: {=AddIt(A1:A10;B10)} |
5 | 8 | 11 | 19 | 19 | 19 | 14 | 19 | 12 | 19 | 23 | 19 | 27 | G1:G10: {=AddThis(A1:A10;B1:B10)} |
6 | 13 | 2 | 15 | 15 | 15 | 19 | 15 | 3 | 15 | 28 | 15 | 18 | Ew+vV H1:H10: {=AddThis(A1;B1:B10)} |
7 | 16 | 16 | 32 | 32 | 32 | 22 | 32 | 17 | 32 | 31 | 32 | 32 | I1:I10: {=AddRec(A1:A10;B1:B10)} |
8 | 17 | 3 | 20 | 20 | 20 | 23 | 20 | 4 | 20 | 32 | 20 | 19 | vV+Ew J1:J10: {=AddRec(A1:A10;B1)} |
9 | 15 | 5 | 20 | 20 | 20 | 21 | 20 | 6 | 20 | 30 | 20 | 21 | K1:K10: {=MTRANS(AddVar(A1:A10;B1:B10))} |
10 | 16 | 6 | 22 | 22 | 22 | 22 | 22 | 7 | 22 | 31 | 22 | 22 | Ew+vV L1:L10: {=MTRANS(AddVar(A10;B1:B10))} |
11 | 22 | 22 | 22 | 22 | |||||||||
12 | 14 | 1 | 15 | 14 | 8 | 10 | 10 | 10 | 10 | Formeln | |||
13 | 6 | 2 | 10 | 6 | 2 | ||||||||
14 | 20 | 3 | 25 | 20 | 10 | h-Basisformel A14:E14: {=A12:E12+A13:E13} | |||||||
15 | 20 | 3 | 25 | 20 | 10 | F11:=AddIt(A10;B10) | A15:E15: {=MTRANS(VPairs(A12:E12;A13:E13;-3))} | ||||||
16 | 20 | 3 | 25 | 20 | 10 | F12:=AddIt(E12;E13) | A16:E16: {=AddIt(A12:E12;A13:E13)} | ||||||
17 | 14 | 10 | 18 | 14 | 10 | H11:=AddThis(A10;B10) | Ew+hV A17:E17: {=AddIt(E12;A13:E13)} | ||||||
18 | 20 | 3 | 25 | 20 | 10 | H12:=AddThis(E12;E13) | A18:E18: {=AddThis(A12:E12;A13:E13)} | ||||||
19 | 20 | 7 | 21 | 20 | 14 | J11:=AddRec(A10;B10) | hV+Ew A19:E19: {=AddThis(A12:E12;A13)} | ||||||
20 | 20 | 3 | 25 | 20 | 10 | J12:=AddRec(E12;E13) | A20:E20: {=AddRec(A12:E12;A13:E13)} | ||||||
21 | 20 | 16 | 24 | 20 | 16 | L11:=AddVar(A10;B10) | Ew+hV A21:E21: {=AddRec(A12;A13:E13)} | ||||||
22 | 20 | 3 | 25 | 20 | 10 | L12:=AddVar(E12;E13) | A22:E22: {=AddVar(A12:E12;A13:E13)} | ||||||
23 | 16 | 3 | 17 | 16 | 10 | hV+Ew A23:E23: {=AddVar(A12:E12;E13)} |
Die zugehörigen UDF-Codes lauten:
Option Explicit
Public Enum cxTriState: cxAsUsed = -2: cxRTrue: cxFalse: cxPTrue: End Enum
Rem Alle UDFs benötigen Enum cxTriState;
' Argumente Vektor (Spalte/Zeile) oder Einzelwert
Function AddIt(x, y)
Dim isArr As cxTriState, i As Long, n As Long, s As Long, z As Long, erg, _
ac As Range
isArr = Abs(IsArray(x)) + 2 * CInt(IsArray(y))
If CBool(isArr) Then
Set ac = Application.Caller: s = ac.Columns.Count: z = ac.Rows.Count
Set ac = Nothing: n = WorksheetFunction.Max(s, z): ReDim erg(n)
For i = 0 To n - 1
Select Case isArr
Case cxAsUsed: erg(i) = x + y(i + 1)
Case cxRTrue: erg(i) = x(i + 1) + y(i + 1)
Case cxPTrue: erg(i) = x(i + 1) + y
End Select
Next i
If z > s Then
AddIt = WorksheetFunction.Transpose(erg)
Else: AddIt = erg
End If
Else: AddIt = x + y
End If
End Function
Function AddThis(x, y)
Dim isArr As cxTriState, i As Long, s As Long, z As Long, adRelBer$, erg(), _
xz As Range, ac As Range
isArr = Abs(IsArray(x)) + 2 * CInt(IsArray(y))
If CBool(isArr) Then
Set ac = Application.Caller: s = ac.Columns.Count: z = ac.Rows.Count
adRelBer = ac.Address: Set ac = Nothing
For Each xz In Range(adRelBer)
i = i + 1: ReDim Preserve erg(1 To i)
Select Case isArr
Case cxAsUsed: erg(i) = x + y(i)
Case cxRTrue: erg(i) = x(i) + y(i)
Case cxPTrue: erg(i) = x(i) + y
End Select
Next xz
If z > s Then
AddThis = WorksheetFunction.Transpose(erg)
Else: AddThis = erg
End If
Else: AddThis = x + y
End If
End Function
Function AddRec(x, y)
Dim isArr As cxTriState, i As Long, s As Long, z As Long, adRelBer$, erg(), _
xz As Range, ac As Range
isArr = Abs(IsArray(x)) + 2 * CInt(IsArray(y))
If CBool(isArr) Then
Set ac = Application.Caller: s = ac.Columns.Count: z = ac.Rows.Count
adRelBer = ac.Address: Set ac = Nothing
For Each xz In Range(adRelBer)
i = i + 1: ReDim Preserve erg(1 To i)
Select Case isArr
Case cxAsUsed: erg(i) = AddRec(x, y(i))
Case cxRTrue: erg(i) = AddRec(x(i), y(i))
Case cxPTrue: erg(i) = AddRec(x(i), y)
End Select
Next xz
If z > s Then
AddRec = WorksheetFunction.Transpose(erg)
Else: AddRec = erg
End If
Else: AddRec = x + y
End If
End Function
Rem Benötigt außerdem UDF Vary
Function AddVar(x, y)
Dim isArr As cxTriState, i As Long, erg(), s(1)
isArr = Abs(IsArray(x)) + 2 * CInt(IsArray(y))
Do: i = i + 1
Select Case isArr
Case cxAsUsed: s(0) = x: s(1) = Vary(y, i)
Case cxRTrue: s(0) = Vary(x, i): s(1) = Vary(y, i)
Case cxFalse: s(0) = Array(Empty, x)(1 \ i): s(1) = Array(Empty, y)(1 \ i)
Case cxPTrue: s(0) = Vary(x, i): s(1) = y
End Select
If IsEmpty(s(0)) Or IsEmpty(s(1)) Then Exit Do
ReDim Preserve erg(1 To i): erg(i) = s(0) + s(1)
Loop
AddVar = erg
End Function
Rem Unterstützt hier UDF AddVar
Function Vary(x, i As Long)
On Error Resume Next
If TypeName(x) = "Range" Then
If i > x.Cells.Count Then Else Vary = x.Cells(i)
Else: If IsError(LBound(x, 2)) Then Else x = WorksheetFunction.Transpose(x)
If i > UBound(x) Then Else Vary = x(i)
End If
End Function
Außerdem wird in der BspTab zu Demo-Zwecken noch die UDF VPairs verwendet, die primär die Aufgabe hat, 2 Vektoren in einen vertikalen Vektor umzuwandeln, dessen Elemente aus horizontalen Vektoren der gepaarten Elemente der QuellVektoren bestehen. Dabei kann je nach Parametrierung eine lfdNr als 3.Element den gepaarten vorangestellt wdn, worauf hier verzichtet wurde. Stattdessen wurde die ebenfalls gegebene Möglichkeit genutzt, die PaarElemente zusammenzufassen (hier natürlich als Summe). Dabei entsteht ein vertikaler Vektor, dessen Elemente aus 1elementigen Vektoren bestehen. Anmerkung: Diese UDF wird hier nicht gezeigt, da sie die 3fache ZeilenZahl meines annähernden PostingRichtwerts hat (@n&r: Ist in PrinzipL4 enthalten).Die 4. der gezeigten UDF ist ein Versuch, die mögliche Fktsweise der o.g. Xl-Steuerung nachzuempfinden. Deshalb verwendet sie intern die 5. der gezeigten UDFs. Die 4. fktioniert also nur mit der 5., die 5. aber auch separat (ähnlich wie die xlFkt INDEX).
Gruß, Luc :-?
PS: Anlass