В excel, как я могу определить, какие именованные диапазоны не указаны в других листах?

Question

У меня есть книга Excel с тысячами названных ссылок на одном листе. Есть ли код VBA, который может сказать мне, какая из этих ссылок не используется (внутри формул) в любом из других листов (их более 25).

Answer 1

One edit. В конце концов я много использовал getridofnames Спасибо Тиму. Мне пришлось многому модифицировать его, и он должен циклически проходить через каждый рабочий лист. Это громоздко, но я думаю, что это работает.

Sub RidOfNames() Dim Myname Как имя Dim я As Integer Dim fdMsg As String Dim т As Boolean

'Search for Sheet1 - If it doesnt exist create it 
Dim wsTest As Worksheet 
Const strSheetName As String = "Sheet1" 

Set wsTest = Nothing 
On Error Resume Next 
Set wsTest = ActiveWorkbook.Worksheets(strSheetName) 
On Error GoTo 0 

If wsTest Is Nothing Then 
    Worksheets.Add.Name = strSheetName 
End If 

'Clear all of Sheet1 
Sheet1.Cells.Clear 

i = 0 
On Error Resume Next 
fdMsg = "" 
For Each myName In Names 
    t = False 
    For Each ws In ThisWorkbook.Worksheets 
     With ws 
      'Do not search Raw Data or Sheet 1 - or it has already been found 
      If ws.Name = "Sheet1" Or ws.Name = "Raw Data" Or t = True Then GoTo myNext 
      ws.Select 
      ws.Range("A1").Select 
      If Cells.Find(What:=myName.Name, _ 
       After:=ActiveCell, _ 
       LookIn:=xlFormulas, _ 
       LookAt:=xlPart, _ 
       SearchOrder:=xlByRows, _ 
       SearchDirection:=xlNext, _ 
       MatchCase:=False, _ 
       SearchFormat:=False).Activate Is Nothing Then 
          ' it was not found 
                 Else 
        t = True ' it was found! 
      End If 

myNext: End С

Next ws 
If t = False Then 
    fdMsg = fdMsg & myName.Name & vbCr 
    Sheets("Sheet1").Range("A1").Offset(i, 0).Value = myName.Name 
    i = i + 1 'increment placement of found named ranges 
    t = False 'set test variable back to false 
End If 
Next myName 
If fdMsg = "" Then 
    MsgBox "No unused names found in the workbook" 
Else 
    MsgBox "Names Not Used:" & vbCr & fdMsg 
End If 

End Sub