hmm
08.04.2019 20:59:13
Kisska
Luc, ich weiß nicht was ich falsch mache. Ich habe alles kopiert, inkl. Enumerationen.
Diesmal habe ich den 2. Code genommen und in Modul 2 gepackt (im Module 1 steht dein Code für Fall 1):
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
Als Fehler erscheint: "Fehler beim Kompilieren: Mehrdeutiger Name: cxTriState".
Ich kenne mich mit VBA kaum aus, komme daher selbst nicht drauf, was ich im Code anpassen müsste.
VG, Kisska