Globale und lokale Namen

Guten Abend
Ich habe in einer Datei mehrere Namen mehrmals vergeben, so bezieht sich
der Name "abc" auf Daten1!A3 (globaler Name)
der Name "abc" auf Daten2!A3 (lokaler Name) und
der Name "abc" auf Daten3!A3 (lokaler Name)
Ich möchte eine Funktion schreiben, die mir die "Fundstellen" der gleichen Namen zurückgibt. Dabei sollten lokale Namen zusätzlich in eckigen Klammern stehen. Für mein Beispiel heisst das:
die Funktion =NamAuswertung("abc") gibt folgenden String zurück:
Daten1!A3 - [Daten1!A3] - [Daten1!A3]
Ich kann zwar abfragen, ob ein Name mehrmals vorkommt (vgl. nachstehend). Ich möchte jedoch, wenn die Variable j um 1 erhöht wird ausgehend von WkBk.Names(i).Name abfragen können, ob es sich um ein globaler Name handelt (und wo ersteht) oder ob es sich um ein lokaler Name handelt (und wo er steht) und diese Informationen dann einer Variable zuweisen, die ich gesamthaft zurückgebe.
Gruss, Peter
<pre>Function AdresseTabelleBereich1(str As String)
Dim CountOfNames As Long, i As Long, j As Long, WkBk As Excel.Workbook
Dim strVergleich As String
Set WkBk = ThisWorkbook
CountOfNames = WkBk.Names.Count
For i = 1 To CountOfNames
strVergleich = WkBk.Names(i).Name
If Mid(strVergleich, InStr(strVergleich, "!") + 1) = str Then j = j + 1
Next
If j > 1 Then
AdresseTabelleBereich1 = "nicht eindeutig"
Else
With ThisWorkbook.Names(str).RefersToRange
AdresseTabelleBereich1 = .Parent.Name & "!" & .Address(0, 0)
End With
End If
End Function</pre>

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Function AdresseTabelleBereich1(str As String) Dim CountOfNames As Long, i As Long, j As Long, strAus() As String CountOfNames = ThisWorkbook.Names.Count ReDim strAus(0 To CountOfNames) For i = 1 To CountOfNames With ThisWorkbook.Names(i) If .Name = str Then strAus(0) = Mid(.RefersTo, 2) ElseIf Right(.Name, Len(str) + 1) = "!" & str Then j = j + 1 ' strAus(j) = "[" & .Parent.Name & "!" & .RefersToRange.Address(0, 0) & "]" strAus(j) = "[" & Mid(.RefersTo, 2) & "]" End If End With Next If strAus(0) = "" Then For i = 0 To j - 1 strAus(i) = strAus(i + 1) Next i ReDim Preserve strAus(0 To j - 1) Else ReDim Preserve strAus(0 To j) End If AdresseTabelleBereich1 = Join(strAus, " - ") End Function

Function AdresseTabelleBereich1(str As String) Dim CountOfNames As Long, i As Long, j As Long, strAus() As String CountOfNames = ThisWorkbook.Names.Count ReDim strAus(0 To CountOfNames) For i = 1 To CountOfNames With ThisWorkbook.Names(i) If .Name = str Then strAus(0) = Replace(Mid(.RefersTo, 2), "$", "") ElseIf Right(.Name, Len(str) + 1) = "!" & str Then j = j + 1 ' With .RefersToRange ' strAus(j) = "[" & .Parent.Name & "!" & .Address(0, 0) & "]" ' End With strAus(j) = "[" & Replace(Mid(.RefersTo, 2), "$", "") & "]" End If End With Next If strAus(0) = "" Then For i = 0 To j - 1 strAus(i) = strAus(i + 1) Next i ReDim Preserve strAus(0 To j - 1) Else ReDim Preserve strAus(0 To j) End If AdresseTabelleBereich1 = Join(strAus, " - ") End Function

Function AdresseTabelleBereich2(str As String) Dim CountOfNames As Long, i As Long, j As Long, strAus() As String str = UCase$(str) CountOfNames = ThisWorkbook.Names.Count ReDim strAus(0 To CountOfNames) For i = 1 To CountOfNames With ThisWorkbook.Names(i) If UCase$(.Name) = str Then strAus(0) = Replace(Mid(.RefersTo, 2), "$", "") ElseIf UCase$(Right(.Name, Len(str) + 1)) = "!" & str Then j = j + 1 strAus(j) = "[" & Replace(Mid(.RefersTo, 2), "$", "") & "]" End If End With Next If strAus(0) = "" Then For i = 0 To j - 1 strAus(i) = strAus(i + 1) Next i ReDim Preserve strAus(0 To j - 1) Else ReDim Preserve strAus(0 To j) End If AdresseTabelleBereich2 = Join(strAus, " - ") End Function

Hallo Erich
Das funktioniert. Vielen Dank. Jetzt habe ich mir noch folgende Überlegung gemacht. Nur wenn sich der Name auf eine Zahl oder eine Formel bezieht und es sich um einen lokalen Namen handelt, sollte zusätzlich der Tabellenname in spitzigen Klammern geliefert werden.
Ich habe mir in deinem Code zweimal Debug.Print eingefügt (vgl. nachstehend) und dann im Direktbereich folgende Ergebnisse erhalten (vgl. weiter unten). Wenn es sich nicht um Formeln oder eine Zahl handelt, ist in der entsprechenden Zeile immer ein "!" im String enthalten.
Könnte man zusätzlich nach dem "!" abfragen und dann den Tabellenname in spitzigen Klammern nur liefern, wenn im String kein "!" enthalten ist?
Gruss, Peter

Function AdresseTabelleBereich3(str As String)
Dim CountOfNames As Long, i As Long, j As Long, strAus() As String
str = UCase$(str)
CountOfNames = ThisWorkbook.Names.Count
ReDim strAus(0 To CountOfNames)
For i = 1 To CountOfNames
With ThisWorkbook.Names(i)
If UCase$(.Name) = str Then
Debug.Print "Bedingung1" & UCase$(.Name) & " " & .RefersTo
strAus(0) = Replace(Mid(.RefersTo, 2), "$", "")
ElseIf UCase$(Right(.Name, Len(str) + 1)) = "!" & str Then
Debug.Print "Bedingung2" & UCase$(.Name) & " " & .RefersTo
j = j + 1
strAus(j) = "[" & Replace(Mid(.RefersTo, 2), "$", "") & "]"
End If
End With
Next
If strAus(0) = "" Then
For i = 0 To j - 1
strAus(i) = strAus(i + 1)
Next i
ReDim Preserve strAus(0 To j - 1)
Else
ReDim Preserve strAus(0 To j)
End If
AdresseTabelleBereich3 = Join(strAus, " - ")
End Function

'''Direktbereich
Bedingung2'ABC (5)'!TESTZAHL =3
Bedingung2DEF!TESTZAHL =19
Bedingung1TESTZAHL =3
Bedingung1TESTZELLE =abc!$N$6
Bedingung2DEF!TESTFORMEL =ROUNDDOWN(100.999,1)
Bedingung2ZZZ!TESTFORMEL =ROUND(19/5,3)
Bedingung1TESTFORMEL =ROUND(19/5,3)
Bedingung2'ABC (5)'!TESTZAHL =3
Bedingung2DEF!TESTZAHL =19
Bedingung1TESTZAHL =3
Bedingung2'ABC (2)'!TESTBEREICH ='abc (2)'!$B$6:$B$12
Bedingung2'ABC (3)'!TESTBEREICH ='abc (3)'!$B$6:$B$12
Bedingung2'ABC (4)'!TESTBEREICH =2
Bedingung2'ABC (5)'!TESTBEREICH =2
Bedingung2'ABC (6)'!TESTBEREICH ='abc (6)'!$H$2:$H$8
Bedingung1TESTBEREICH =abc!$M$2:$M$8
https://www.herber.de/bbs/user/80632.xlsm

Beliebteste Forumthreads (12 Monate)

	A	B	C
19	aaBereich		[def!B1:B2] - [def!B1:B2] - [def!C8:C9]
20	aaFormel		["mit Ausruf!"] - [abc!A24+1]
21
22	aaBereich		<abc>[def!B1:B2] - <def>[def!B1:B2] - <zzz>[def!C8:C9]
23	aaFormel		<abc>["mit Ausruf!"] - <def>[abc!A24+1]

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread