Formel-Eigenbau "Welche Namensbereiche beinhalten den Bezugsbereich?"

[LB1972]

Servus Community,

ich versuche eine Formel zu finden,
die mir ausgibt, in welchen Namensbezügen der untersuchte Range beinhaltet ist.

In den Boardmitteln habe ich nichts passendes gefunden und deshalb versucht, einen
Eigenbau zu kreieren.

So soll die Formel auf dem Excelblatt funktionieren:

=Bereich_in_Name(Adresse;Zahl)

• Bereich_in_Name [=Formelname]
  
• Adresse               [= Bezug]
  
• Zahl                    [ = 1. Name, in dem der Bezug beinhaltet ist / 2. Name, in dem der Bezug beinhaltet ist.......]
  

Leider komme ich mit diesem Ansatz

Code:

Public Function Bereich_in_Name(Bereich As Range, i As Integer) As String

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



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

k = 0
Set c = Nothing

On Error Resume Next    'Fehler ignorieren für nicht existiernde Schnittbereiche

   For Each nam In ActiveWorkbook.Names    'Schleife alle Namen durchlaufen
   
       Set c = Application.Intersect(Bereich, Range(nam))  'Schnittbereich bilden
 
           If c = Bereich Then             'Wenn Schnittbereich dem Auswertebereich entspricht
               k = k + 1                       'Indexzähler um 1 erhöhen
               objSD(k) = nam.Name             'Listeneintrag zum Index Name des ermittelten Namensbereichs
               
           End If
       Set c = Nothing                     'Rangevariable leeren
 
   Next

On Error GoTo 0                             'Fehlerignorierung rücksetzen


Bereich_in_Name = objSD(i)                  'Ausgabe des i-ten Objektes aus dem Listing

End Function

noch nicht ans gewünschte Ziel.


Ich erhalte dabei immer eine Auflistung aller Namen der Mappe,
statt nur derjenigen, die einen Schnittbereich mit meinem gewählten Bezug haben.

Kann mir hier jemand weiterhelfen?


Hier habe ich die Beispieldatei, in der ich versucht habe, das ganze abzubilden:


  LB1972_20170927_Prüfung_in_Namen_beinhaltet.xlsm (Größe: 19,09 KB / Downloads: 3)


Falls es eine einfachere Lösung hierzu gibt, z.B. einen boardmittelbasierten Formelansatz,
bin ich natürlich auch um diesbezügliche Hinweise dankbar.
(es muss ja nicht immer VBA sein...)

Vielen Dank schon mal für die Unterstützung.

Gruß

Ludwig

[Kuwer]

Hallo Ludwig,

Public Function Bereich_in_Name(Bereich As Range, i As Integer) As String

 '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

 'Dictionary erzeugen

 Set objSD = CreateObject("scripting.dictionary")

 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) = nam.Name             'Listeneintrag zum Index Name des ermittelten Namensbereichs

   End If

 Next nam

 Bereich_in_Name = objSD(i)          'Ausgabe des i-ten Objektes aus dem Listing

End Function

Gruß Uwe

[LB1972]

Hallo Uwe,

danke.

Ich hab auf deinem Vorschlag basierend noch ein paar Dinge ergänzt
(Formel ist nun volatil; Namen, die sich nur auf ein bestimmtes Tabellenblatt beziehen werden gekürzt ausgegeben usw.)


  LB1972_20170927_Prüfung_in_Namen_beinhaltet_update.xlsm (Größe: 20,4 KB / Downloads: 0)


Die Eigenbauformel sieht jetzt so aus

Code:

Option Explicit

Public Function Bereich_in_Name(Bereich As Range, i As Integer) As String


Application.Volatile True       'Dynamisierung der Formel

'Verschiedene Variablen
Dim objSD As Object 'Scripting-Objekt zum Listen der beinhalteten Namen
Dim shtBereich As Worksheet 'Variable für das geprüfte Sheet

Dim lgWSName As Long       'Variable für die Länge des Worksheetnamens
Dim k As Integer    ' Zähler für Listing


Dim nam As Name     ' Namensvariable zum Schleifendurchlauf aller Namen
Dim strgRohErgebnis As String 'Variable für die Zwischenverarbeitung des Tabellenamens

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


Set shtBereich = Bereich.Worksheet     'Workeetname auslesen
lgWSName = Len(shtBereich.Name) + 1  'Länge des Worksheetnames + 1 (Für Berücksichtigung des "!")


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) = nam.Name             'Listeneintrag zum Index Name des ermittelten Namensbereichs
  End If
Next nam

strgRohErgebnis = objSD(i)          'Ausgabe des i-ten Objektes aus dem Listing



If Left(strgRohErgebnis, lgWSName) = shtBereich.Name & "!" Then    'Falls der ermittelte Name sich nur auf eine bestimmte Tabelle bezieht (Tabellenname ohne Hochkommata)
   strgRohErgebnis = Mid(strgRohErgebnis, lgWSName + 1, 1000)
End If

 
If Left(strgRohErgebnis, lgWSName + 2) = "'" & shtBereich.Name & "'!" Then  ''Falls der ermittelte Name sich nur auf eine bestimmte Tabelle bezieht (Tabellenname mit Hochkommata)
   strgRohErgebnis = Mid(strgRohErgebnis, lgWSName + 3, 1000)
End If

If strgRohErgebnis = Empty Then strgRohErgebnis = "#NV"

Bereich_in_Name = strgRohErgebnis

End Function

... und macht alles was sie soll...




Schönen Abend noch

Gruß

Ludwig

[Kuwer]

Hallo Ludwig,

dann vielleicht auch so:

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

 

 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

 

 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,

nicht nur vielleicht, sondern sicher.

Merci nochmals

Gruß Ludwig