Würde das deinen Intentionen entsprechen, ...
07.08.2016 16:58:31
Luc:-?
…Lukas?
Hier wurden 2 UDFs verwendet, NoErrRange und DataSet jeweils in ihrer aktuellen Version 1.3. Beide sind im Archiv enthalten, allerdings nicht in der hier benötigten Version. Die 2. wird dort (bzw Archiv) veröffentlicht, die 1. folgt unten.
Die grauen Flächen kaschieren #NV-Anzeigen, die sich daraus ergeben, dass die EinzelVektoren nicht immer gleichlang sind, was an der Anzahl im SpaltenKopf zu erkennen ist. Man kann sie vermeiden, indem man pro Spalte nur die dort angezeigte ZeilenAnzahl auswählt, wenn man die MatrixFml über die Zeilen anlegt.
Man kann natürlich auch alles auf 1× so berechnen, aber das würde kompliziertere Fmln erfordern, u.a. weil DataSet idR nur Vektoren verarbeitet.
Public Enum cxTriState: cxAsUsed = -2: cxTrue: cxFalse: cxCTrue: End Enum
Rem Erzeugt ggf 1 unzusammenhängd Bereich (MehrfachAuswahl) aus Bezug lt Arg1
' ohne darin uU enthaltene FehlerWerte; hilfreich b.Fktt, d.nur Bereiche o.
' FWerte, aber auch unzusammhängende verarbeiten können, bspw TEILERGEBNIS;
' Datenfeld-verarbeitde Fktt kommen so idR ohne MxFmlForm aus (außer b.Arg3
' als DFeld); nur 1 Zelle als Arg1 kn ggf F-Wert liefern, b.VektorForm wird
' auch b.solitärer FktsVerwendg in (Mx-)Fmln ggf vollständ Ergebnis gelieft
' (außer uU b.entstandm unzusammhgd Bereich), b.MatrixForm könn d.Werte idR
' m.INDEX/Var2 aus d.unzusammhgd ErgebnBereich gelesen wdn; m.Arg2=WAHR/0
' wird d.Ergebn auf sichtbare Zellen beschränkt, wobei dies b.Ausblenden d.
' Zelle m.der d.Fkt enthaltenden Fml dort Anzeige d.StandardFWerts bewirkt;
' in Arg3 kn auf 1 Bereich m.WahrhWerten gleicher Größe wie Arg1 vwiesen or
' 1 glchgroß Datenfeld (MxKonst oder Ausdruck) angegeben wdn, wird 0/FALSCH
' angegeben, macht Arg2=1/WAHR d.Fkt nur volatil!
' Achtung! Fkt benött b.ggf verlangter AutoAktualisierg d.NichtBerücksichtg
' ausgeblendeter Zellen d.Auslösg d.Neuberechng ([F9] bzw Edit 1er beliebig
' Zelle - v.Arg2 abhängig: WAHR/0 ->partielle Volatilität zur Erzielg dss
' speziellen Verhaltens; Fkt verwendet Enumeration cxTriState (anlegen)!
' Vs1.3 -LSr.CyWorXxl -cd:20150710 -1pub:20150721herber(1.2) -lupd:20151114t
Function NoErrRange(Bereich As Range, Optional ByVal nurVisZ As Boolean, _
Optional ByVal ZusKrit) As Range
Dim cct As Long, cif As Long, cix As Long, rct As Long, rix As Long, rif As Long, _
tix As Integer, hasCrits As cxTriState, tmpR(2) As Range, xZ As Range, zK As Range
Application.Volatile nurVisZ: On Error GoTo ex
If IsMissing(ZusKrit) Then ZusKrit = True
With Bereich
If .Cells.Count = 1 Then
If IsError(Bereich) Then Exit Function
If nurVisZ Then
If Not (.EntireRow.Hidden Or .EntireColumn.Hidden) Then _
Set tmpR(0) = Bereich
Else: Set tmpR(0) = Bereich
End If
If Not IsArray(ZusKrit) Then
If CBool(ZusKrit) Then Set NoErrRange = tmpR(0)
Else: Set NoErrRange = tmpR(0)
End If
Set tmpR(0) = Nothing: Exit Function
End If
End With
hasCrits = 2 * CInt(nurVisZ) Xor CInt(IsArray(ZusKrit))
If CBool(hasCrits Mod 2) Then
If TypeName(ZusKrit) = "Range" Then
Set zK = ZusKrit: cct = zK.Columns.Count: rct = zK.Rows.Count: cif = 1: rif = 1
Else: On Error Resume Next
If IsError(LBound(ZusKrit, 2)) Then
If Bereich.Columns.Count = 1 Then _
ZusKrit = WorksheetFunction.Transpose(ZusKrit)
ElseIf Bereich.Rows.Count = 1 Then
ZusKrit = WorksheetFunction.Transpose(ZusKrit)
End If
If IsError(LBound(ZusKrit, 2)) Then
On Error GoTo ex: cif = LBound(ZusKrit)
cct = UBound(ZusKrit) + 1 - cif: rct = 1
Else: On Error GoTo ex
rif = LBound(ZusKrit, 1): rct = UBound(ZusKrit, 1) + 1 - rif
cif = LBound(ZusKrit, 2): cct = UBound(ZusKrit, 2) + 1 - cif
End If
End If
On Abs(Bereich.Columns.Count cct Or Bereich.Rows.Count rct) GoTo ex
Else: If Not CBool(ZusKrit) Then hasCrits = cxFalse
End If
For Each xZ In Bereich
If Not IsError(xZ) Then
Select Case hasCrits
Case cxCTrue
GoSub rt: GoSub vz
If Not (tmpR(1) Is Nothing Or tmpR(2) Is Nothing) Then Set tmpR(0) = tmpR(1)
Case cxFalse: Set tmpR(0) = xZ
Case cxTrue
rt: If Not zK Is Nothing Then
If CBool(zK.Cells(rix + rif, cix + cif)) Then Set tmpR(1) = xZ
ElseIf rct = 1 Then
If CBool(ZusKrit(cix + cif)) Then Set tmpR(1) = xZ
ElseIf CBool(ZusKrit(rix + rif, cix + cif)) Then
Set tmpR(1) = xZ
End If
If hasCrits = cxCTrue Then Return Else Set tmpR(0) = tmpR(1)
Case cxAsUsed
vz: If Not (xZ.EntireRow.Hidden Or _
xZ.EntireColumn.Hidden) Then Set tmpR(2) = xZ
If hasCrits = cxCTrue Then Return Else Set tmpR(0) = tmpR(2)
End Select
If Not tmpR(0) Is Nothing Then
If Not NoErrRange Is Nothing Then
Set NoErrRange = Union(NoErrRange, tmpR(0))
Else: Set NoErrRange = tmpR(0)
End If
End If
End If
If CBool(hasCrits Mod 2) Then _
cix = (cix + 1) Mod cct: rix = rix - CInt(cix = 0)
For tix = LBound(tmpR) To UBound(tmpR): Set tmpR(tix) = Nothing: Next tix
Next xZ
ex: Set zK = Nothing
End Function
Feedback nicht unerwünscht! Gruß, Luc :-?
Besser informiert mit …