Na, da wir hier so nett plaudern, noch eine ...
07.05.2013 14:58:29
Luc:-?
…Zugabe, Mustafa;
mal als Bsp, wie man auch noch ein Datenfeld erzeugen könnte, das dann aber immer ein horizontal-gerichteter (also 1dimensionaler) Vektor ist, dessen Elemente ebenfalls aus beliebigen Datenfeldern bestehen können.
Rem Erzeugt DatenFeld aus Ausdruck-Ergebnissen bzw Bereichen
' o/m ZwischenSpeicherg desselben; Arg1: fehlt/leer keine,
' =0 alleinige ZwiSpeicherg in einer Formel, sonst mehrere
' separate ZwiSpeichrgg (0
' m.Speichrg) - Dezimale f.DF-Elem-Indizrg, enthält DF nur
' 1 Elem, gilt Arg2 nur dafür, auch ±0.0/0,0 als Text mögl
' f.Zusfass v.Arg3-Vektt zu Mx (anderenfalls kn d.Ergebnis
' nicht m.ZFml abgebildet wdn); Arg3: DF-Elemente (Skalar/
' Vektor/Matrix), fehlt bewirkt Ergebn aus ZwiSpeicherg lt
' Argg1/2 (o.erneute ZwiSpeicherg)! B.DirektAufruf in Sub-
' proz fehlendes Arg1 als Null bzw ggf 0/""/Empty (f.Lösch
' gesamt ZwiSpeicherInhalts), Arg2 als Null/Empty angeben,
' da ds eigtl opt sind, aber vor Arg3ff nicht sein dürfen!
' Falls d.FktsErgebn nur ein 1elementiger Vektor ist, wird
' es zwecks EinsatzUniversalität in 1 Skalar (bzw 1zlText)
' umgewandelt (ist zB b.xlFktt ZEILE/SPALTE nicht d.Fall)!
' Vs1.8 -LSr -cd:20130423 -1pub:20130507herber -lupd:20130506t
Function Collect(ByVal ZwiSpIx, ByVal AuswElem, ParamArray Ausdruck())
Static dTz As String, ZwiSp As Variant
Dim relMix As Long, relNix As Long, relPix As Long, relSix As Long, _
isMxPos As Boolean, isNoExp As Boolean, isNoInst As Boolean, _
isNoPos As Boolean, isNoRest As Boolean, isSecSt As Boolean, _
elVec, erg, tmZwiSp, zwErg As Variant
On Error GoTo fx
If dTz = "" Then dTz = Application.International(xlDecimalSeparator)
isNoExp = IsMissing(Ausdruck): isNoPos = IsMissing(AuswElem)
If Not isNoPos And (IsNull(AuswElem) Or _
IsEmpty(AuswElem)) Then isNoPos = True
If IsMissing(ZwiSpIx) Or IsNull(ZwiSpIx) Then
isNoRest = True: isNoInst = True
ElseIf IsError(ZwiSpIx) Then
Err.Raise CLng(ZwiSpIx)
ElseIf ZwiSpIx = "" Or IsEmpty(ZwiSpIx) Then
isNoRest = True: isNoInst = True: ZwiSp = Empty
ElseIf IsNumeric(ZwiSpIx) Then
Let isNoInst = ZwiSpIx = 0: isNoRest = isNoExp
If Not isNoInst Then
relSix = Abs(ZwiSpIx) - 1
If Not isNoRest Then
If IsEmpty(ZwiSp) Then
ReDim ZwiSp(relSix)
ElseIf IsArray(ZwiSp) Then
If relSix > UBound(ZwiSp) Then ReDim Preserve ZwiSp(relSix)
Else: tmZwiSp = ZwiSp: ReDim ZwiSp(relSix): ZwiSp(0) = tmZwiSp
End If
If CLng(ZwiSpIx) 0: isMxPos = Abs(CDbl(AuswElem)) relPix
If IsArray(zwErg) Then
If CBool(relPix) Then
If LBound(zwErg) = UBound(zwErg) Then _
erg = zwErg(LBound(zwErg)) Else erg = zwErg
With WorksheetFunction
If isMxPos And IsArray(erg) Then
On Error Resume Next
If IsError(LBound(erg, 2)) Then
tmZwiSp = erg(LBound(erg))
If IsError(LBound(tmZwiSp)) Then
On Error GoTo fx: Err.Raise xlErrRef
Else: On Error GoTo fx
relPix = .Min(.Max(LBound(erg), relPix - 1 + LBound(erg)), _
UBound(erg))
tmZwiSp = erg(relPix)
relMix = .Min(.Max(LBound(tmZwiSp), CLng(Split(AuswElem, _
dTz)(1)) - 1 + LBound(tmZwiSp)), UBound(tmZwiSp))
End If
Collect = erg(relPix)(relMix)
Else: On Error GoTo fx 'noch testen !!!
relMix = .Min(.Max(LBound(erg, 2), CLng(Mid(CStr(Abs(AuswElem) - _
relPix), 3)) - 1 + LBound(erg, 2)), UBound(erg, 2))
relPix = .Min(.Max(LBound(erg), relPix - 1 + LBound(erg)), _
UBound(erg))
Collect = erg(relPix, relMix)
End If
ElseIf IsArray(erg) Then
relPix = .Min(.Max(LBound(erg), relPix - 1 + LBound(erg)), UBound(erg))
Collect = erg(relPix)
Else: Collect = erg
End If
End With
ElseIf Replace(Replace(AuswElem, dTz, "."), "-", "") = "0.0" Then
On Error Resume Next
isSecSt = Left(AuswElem, 1) "-": tmZwiSp = Ausdruck(relPix)
If IsError(LBound(tmZwiSp, 2)) Then
On Error GoTo fx
Else: On Error GoTo fx
If LBound(tmZwiSp, 2) = UBound(tmZwiSp, 2) Then Else Err.Raise xlErrRef
End If
relMix = UBound(tmZwiSp) - LBound(tmZwiSp): ReDim tmZwiSp(relMix, relPix)
For relPix = relPix To UBound(Ausdruck)
relNix = 0: ReDim Preserve tmZwiSp(relMix, relPix)
For Each elVec In Ausdruck(relPix)
If relNix > relMix Then Exit For
tmZwiSp(relNix, relPix) = elVec
relNix = relNix + 1
Next elVec
If Not IsEmpty(elVec) Then Exit For
Next relPix
If UBound(tmZwiSp, 2) xlErrNA: Collect = CVErr(xlErrNA)
Case Else: Collect = CVErr(Err.Number)
End Select
End If
End Function
Das ist quasi eine Vorabversion einer meiner neuesten Kreationen (die allerdings doch schon etliche Entwicklungsstufen durchlaufen hatte bis sie einigermaßen zufriedenstellend fktionierte), mit der man beliebige Datenfelder (bspw aus Ausdrücken)* und Bereiche „einsammeln“ kann. Ihre volle Kapazität erreicht sie iaR nur bei Verwendung in Subprozeduren. Als UDF in ZellFmln folgt sie meinen zuvor gegebenen Hinweisen zu DFeldern — sie kann auf Grund der primären 1Dimensionalität des ParamArray-Vektors entweder nur mehrere Skalare oder nur einen Vektor bzw Matrix als Argument3 im TabBlatt wiedergeben (merke: mit Angabe eines Bereichs als Arg eines ParamArrays belegt man stets nur ein Element desselben, niemals mehrere [mit seinen EinzelZellen]!). Deshalb habe ich das Arg2 vorgesehen, mit dem man eine WiedergabeAuswahl treffen kann (INDEX-Fkt würde nicht wirken, da sie als Arg1 schon einen F-Wert bekäme). Außerdem lassen sich auch mehrere vertikal orientierte Vektoren zu einer klassischen Matrix vereinen (Arg2="0,0" bzw "-0,0").
Bei Verwendung in einer Subroutine könnten so auch Bereiche mehrerer Blätter in einem Variablen-Variant gehalten wdn (noch nicht getestet!). Im TabBlatt wäre das nur sinnvoll, wenn nacheinander aus dem erzeugten Variant gewählt wdn kann. Deshalb habe ich noch Arg1 hinzugefügt, mit dem eine quasi Zwischenspeicherungsebene für das FktsErgebnis festgelegt wdn kann, so dass man in gleicher Fml darauf zurückgreifen kann.
Falls du an der UDF interessiert bist und noch fragen hast oder dir beim Testen etwas auffällt, kannst du dich ja noch mal melden.
* Ein Ausdruck und damit ein vom ZellBereich losgelöstes Datenfeld entsteht schon durch die Notation --A1:B2 und kann deshalb von neueren xlFktt, die zwingend einen Bereichsbezug verlangen, wie RANG, ZÄHLENWENN u.a. nicht verarbeitet wdn — von Collect aber schon!
Viel Spaß, Luc :-?