UDF funktiniert nicht mehr

[LB1972]

Hallo zusammen,


ich hatte vor einiger Zeit
mit eurer freundlichen Unterstützung eine
UDF gebaut,
die die ausgibt, zu welchen definierten Namen ein
bestimmter Bereich gehört.

http://www.clever-excel-forum.de/thread-12040.html


Das hat damals auch - Uwe (Kuwer) sei Dank-  funktioniert.

Nun wollte ich heute darauf zurückgreifen und -siehe da-
in meiner Datei funktioniert sie nicht mehr:


  LB1972_Testdatei_Formel_Bereichsermittlung.xlsm (Größe: 24,61 KB / Downloads: 6)

Leider komme ich nicht drauf, was falsch läuft.

Die Formel in Tabelle1 K9 müsste eigentlich "gelb" als Ergebnis bringen.

Für Anregungen, wo der Fehler liegt, bin ich dankbar.

Danke schon mal und

viele Grüße

Ludwig

[Kuwer]

Hallo Ludwig,

da sind etliche Namen enthalten, die sich nicht auf Ranges beziehen. Das führt dann zu Fehlern.
Füge einfach vor der Schleife diese Zeile ein:

On Error Resume Next

.Dann läuft die Funktion trotzdem durch.

Gruß Uwe

[LB1972]

Hallo Uwe,

danke für den

"Aftersales-Service".

Klappt jetzt mit

Code:

Public Function Bereich_in_Name(Bereich As Range, i As Integer) As String
Application.Volatile    'Dynamisierung der Funktion

'Verschiedene Variablen
Dim objSD As Object 'Scripting-Objekt zum Listen der beinhalteten Namen
Dim myRange As Range 'Variable für Hilfsbereich
Dim k As Integer    ' Zähler für Listing
Dim nam As Name     ' Namensvariable zum Schleifendurchlauf aller Namen

Set objSD = CreateObject("scripting.dictionary")    'Dictionary erzeugen

For Each nam In ActiveWorkbook.Names    'Schleife alle Namen durchlaufen
   Set myRange = Nothing
   On Error Resume Next
       Set myRange = Application.Intersect(Bereich, Range(nam))
   On Error GoTo 0
  If Not myRange Is Nothing Then 'wenn es einen Schnittbereich gibt
    k = k + 1                                               'Indexzähler um 1 erhöhen
    objSD(k) = Mid(nam.Name, InStrRev(nam.Name, "!") + 1)   'Listeneintrag zum Index Name des ermittelten Namensbereichs
  End If
   

Next nam

Bereich_in_Name = IIf(Len(objSD(i)), objSD(i), "#NV")        'Ausgabe des i-ten Objektes aus dem Listing
End Function

Viele Grüße
Ludwig

[Kuwer]

Hallo Ludwig,

hat es mit der Aktivierung der Fehlerbehandlungsroutine außerhalb der Schleife, wie von mir vorgeschlagen, nicht funktioniert?

Gruß Uwe

[LB1972]

Hallo Uwe,

leider nein.

Der Effekt dabei ist, dass ich alle Namen in der Mappe in das Dictionary einsammle
und so die gewünschte Schnittmengenbildung mit dem, in der Formel angewählten
Bereich, aushebele.

Gruß

Ludwig

[Kuwer]

Hallo Ludwig,

ich meinte es so, und es funktioniert bei mir :

Public Function Bereich_in_Name(Bereich As Range, i As Long) As String
 Application.Volatile    'Dynamisierung der Funktion
 
 'Verschiedene Variablen
 Dim objSD As Object 'Scripting-Objekt zum Listen der beinhalteten Namen
 Dim k As Integer    ' Zähler für Listing
 Dim nam As Name     ' Namensvariable zum Schleifendurchlauf aller Namen
 
 Set objSD = CreateObject("scripting.dictionary")    'Dictionary erzeugen
 On Error Resume Next
 For Each nam In ActiveWorkbook.Names    'Schleife alle Namen durchlaufen
   If Not Application.Intersect(Bereich, Range(nam)) Is Nothing Then 'wenn es einen Schnittbereich gibt
     k = k + 1                                               'Indexzähler um 1 erhöhen
     objSD(k) = Mid(nam.Name, InStrRev(nam.Name, "!") + 1)   'Listeneintrag zum Index Name des ermittelten Namensbereichs
   End If
 Next nam
 On Error GoTo 0
 Bereich_in_Name = IIf(Len(objSD(i)), objSD(i), "#NV")        'Ausgabe des i-ten Objektes aus dem Listing
End Function

Gruß Uwe

[LB1972]

Hallo Uwe,

ich hab deine Version bei mir nochmal getestet.

Sie bringt bei mir das beschriebene Ergebnis:

Der Effekt dabei ist, dass ich alle Namen in der Mappe in das Dictionary einsammle
und so die gewünschte Schnittmengenbildung mit dem, in der Formel angewählten
Bereich, aushebele.

Da meine Mappe eine ganze Reihe an Namen hat,
die sich nicht auf Zellbereiche beziehen, bzw. sich auf andere Blätter beziehen usw.

   
erscheint mir das aber mittlerweile plausibel.
Insofern bleibe ich bei meiner Version von 16.12.2017 17:39 Uhr.

Falls du noch weiter Zeit aufwenden magst, dann lass es mich wissen, ob deine Version
auch parallel zu einer Reihe von weiteren Namen
(definiert auf andere Tabellenblätter, bzw. z.B. so
   
definiert)
funktioniert.

Danke

Gruß

Ludwig

[Kuwer]

Hallo Ludwig,

jaaa, jetzt habe ich es auch kapiert.  
Hier jetzt mit Fehlerbehandlung:

Public Function Bereich_in_Name(Bereich As Range, i As Integer) As String
 Application.Volatile    'Dynamisierung der Funktion
 
 'Verschiedene Variablen
 Dim objSD As Object 'Scripting-Objekt zum Listen der beinhalteten Namen
 Dim k As Integer    ' Zähler für Listing
 Dim nam As Name     ' Namensvariable zum Schleifendurchlauf aller Namen
 
 Set objSD = CreateObject("scripting.dictionary")    'Dictionary erzeugen
 On Error Resume Next
 For Each nam In ActiveWorkbook.Names    'Schleife alle Namen durchlaufen
   If Not Application.Intersect(Bereich, Range(nam)) Is Nothing Then 'wenn es einen Schnittbereich gibt
     If Err.Number = 0 Then
       k = k + 1                                               'Indexzähler um 1 erhöhen
       objSD(k) = Mid(nam.Name, InStrRev(nam.Name, "!") + 1)   'Listeneintrag zum Index Name des ermittelten Namensbereichs
     Else
       Err.Clear
     End If
   End If
 Next nam
 On Error GoTo 0
 Bereich_in_Name = IIf(Len(objSD(i)), objSD(i), "#NV")        'Ausgabe des i-ten Objektes aus dem Listing
End Function

Gruß Uwe

[LB1972]

:18: :15:


Gruß

Ludwig