Namen - RefersTo - RefersTo Range - auslesen!

Frage: In Tabellenblättern ist einer Zelle oder einem Range ein Name zugeordnet. Auf einem neuen Tabellenblatt sollen nun die Werte der Namen und die Zugehörigkeit ausgegeben werden:

Namen - RefersTo - RefersTo Range - auslesen...[ZIP, 50 KB]

Code gehört in ein allgemeines Modul:
Option Explicit
Public Sub Eine_Zelle()
Dim blnFrage As Boolean
Dim intCount As Integer
Dim nmName As Name
On Error GoTo Fin
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Worksheets.Add After:=Sheets(Sheets.Count)
For Each nmName In ThisWorkbook.Names
If LCase(nmName.Name) Like "*nettopreis" Then
With ActiveSheet
.Cells(intCount + 1, 1).Value = _
nmName.RefersToRange.Text
.Cells(intCount + 1, 2).Value = _
nmName.RefersTo
.Cells(intCount + 1, 3).Value = _
nmName.Name
intCount = intCount + 1
blnFrage = True
End With
End If
Next nmName
Fin:
If Err.Number <> 0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
If Not blnFrage Then ActiveSheet.Delete
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
Public Sub Einen_Range()
Dim blnFrage As Boolean
Dim intCount As Integer
Dim intTMP As Integer
Dim nmName As Name
On Error GoTo Fin
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Worksheets.Add After:=Sheets(Sheets.Count)
For Each nmName In ThisWorkbook.Names
If LCase(nmName.Name) Like "*netto*" Then
If nmName.RefersToRange.Count > 1 Then
For intTMP = 1 To nmName.RefersToRange.Count
With ActiveSheet
.Cells(intCount + 1, 1).Value = _
nmName.RefersToRange.Cells _
(intTMP).Value
.Cells(intCount + 1, 2).Value = _
nmName.RefersTo
.Cells(intCount + 1, 3).Value = _
nmName.Name
intCount = intCount + 1
blnFrage = True
End With
Next intTMP
Else
With ActiveSheet
.Cells(intCount + 1, 1).Value = _
nmName.RefersToRange.Text
.Cells(intCount + 1, 2).Value = _
nmName.RefersTo
.Cells(intCount + 1, 3).Value = _
nmName.Name
intCount = intCount + 1
blnFrage = True
End With
End If
End If
Next nmName
Fin:
If Err.Number <> 0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
If Not blnFrage Then ActiveSheet.Delete
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub

Kommentare

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...