Trova gli intervalli con nome utilizzati nella grande cartella di lavoro

Question

Ho una lista di 594 intervalli denominati in una cartella di lavoro con circa 20 fogli, ogni foglio ha circa 200 colonne di dati. Ho bisogno di scoprire dove vengono utilizzati gli intervalli denominati in modo da rimuovere quelli irrilevanti. Ho incollato un elenco di intervalli denominati sul foglio e quindi ho cercato di scoprire se erano stati utilizzati in una formula registrandoli e quindi utilizzando il metodo find in tutti i fogli e le colonne. Il problema è nonostante l'utilizzo di lookin xlformulas, recupera l'intervallo denominato anche se è solo un testo.

Qui è la mia (aggiornato) tentativo (se non è già evidente, io sono un dilettante):

Application.ScreenUpdating = False 

Count = ActiveWorkbook.Sheets.Count 

Sheets(Count).Activate 

Dim locr(1 To 595) 
Dim locc(1 To 595) 
Dim locn(1 To 595) 
Dim nam(1 To 595) 

Dim rng As Range 

Range("a1").Select 

    For X = 1 To 595 'populate array with named ranges 
     ActiveCell.Offset(1, 0).Select 
     nam(X) = ActiveCell.Value 
    Next X 


      For i = 1 To 595 'name loop 


       For j = 1 To (Count - 1) 'sheet loop 


        Sheets(j).Activate 
        On Error Resume Next 
        Set orange = Sheets(j).Cells.SpecialCells(xlCellTypeFormulas) 'limit range to cells that only contain formulas 

        On Error GoTo 20 'if no formulas in sheet, go to next sheet 

         If Not orange Is Nothing Then 
          Set rng = orange.Find(What:=nam(i), _ 
              LookIn:=xlFormulas, _ 
              LookAt:=xlPart, _ 
              SearchOrder:=xlByRows, _ 
              SearchDirection:=xlNext, _ 
              MatchCase:=False) 'find named range 

           If Not rng Is Nothing Then 'if named range found 

            Application.Goto rng, True 'go to cell where name range found and record address 

            locr(i) = ActiveCell.Row 
            locc(i) = ActiveCell.Column 
            locn(i) = ActiveSheet.Name 

           GoTo 10 'value found, go to next sheet 

           Else 

           End If 

         Else 
         End If 


20    Next j 

      locr(i) = "" 'record empty since "rng" is empty 
      locr(i) = "" 
      locr(i) = "" 

10   Next i 

Sheets(Count).Activate 
Range("c1").Select 
b = 1 

    For a = 1 To 595 'populate addresses of named ranges 


    ActiveCell.Offset(b, 2).Value = locr(a) 
    ActiveCell.Offset(b, 1).Value = locc(a) 
    ActiveCell.Offset(b, 0).Value = locn(a) 
    b = b + 1 

    Next a 

Answer 1

Ecco un modo che posso pensare. Lo spiegherò in 2 parti.

PARTE 1

Diciamo che abbiamo un intervallo denominato Sid.

Questa parola Sid può essere visualizzata in una qualsiasi di queste forme come mostrato nell'immagine seguente. Perché inizia con =? Ciò è stato spiegato in Part2 di seguito.

=Sid '<~~ 1 
="Sid" '<~~ 2 
=XSid '<~~ 3 
=SidX '<~~ 4 
=_Sid '<~~ 5 
=Sid_ '<~~ 6 
=(Sid) '<~~ 7 

Eventuali altri scenari, immagino sarà un sottoinsieme di quanto sopra. Di questi, l'unica trovata valida nel nostro caso è la prima e l'ultima poiché stiamo cercando la nostra gamma.

Quindi, ecco una funzione rapida per verificare se la formula della cella ha un intervallo denominato o meno. Sono sicuro che può essere reso più efficiente

Function isNamedRangePresent(rng As Range, s As String) As Boolean 
    Dim sFormula As String 
    Dim pos1 As Long, pos2 As Long, sLen As Long, i As Long 

    sFormula = rng.Formula: sLen = Len(sFormula) 

    pos2 = 1 

    Do 
     pos1 = InStr(pos2, sFormula, s) - 1 
     If pos1 < 1 Then Exit Do 

     isNamedRangePresent = True 

     For i = 65 To 90 
      '~~> A-Z before Sid for example XSid 
      If UCase(Mid(sFormula, pos1, 1)) = Chr(i) Then 
       isNamedRangePresent = False 
       Exit For 
      End If 
     Next i 

     '~~> Check for " for example "Sid 
     If isNamedRangePresent = True Then _ 
     If UCase(Mid(sFormula, pos1, 1)) = Chr(34) Then isNamedRangePresent = False 
     '~~> Check for underscore for example _Sid 
     If isNamedRangePresent = True Then _ 
     If UCase(Mid(sFormula, pos1, 1)) = Chr(95) Then isNamedRangePresent = False 

     pos2 = pos1 + Len(s) + 1 

     If pos2 <= sLen Then 
      For i = 65 To 90 
       '~~> A-Z after Sid for example SidX 
       If UCase(Mid(sFormula, pos2, 1)) = Chr(i) Then 
        isNamedRangePresent = False 
        Exit For 
       End If 
      Next i 

      '~~> "Sid 
      If isNamedRangePresent = True Then _ 
      If UCase(Mid(sFormula, pos2, 1)) = Chr(34) Then isNamedRangePresent = False 
      '~~> _Sid 
      If isNamedRangePresent = True Then _ 
      If UCase(Mid(sFormula, pos2, 1)) = Chr(95) Then isNamedRangePresent = False 
     End If 
    Loop 
End Function 

Così nel primo e l'ultimo caso, Debug.Print isNamedRangePresent(Range("D2"), "Sid") vi darà True vedere questo

PARTE 2

Ora venendo allo .Find. Vedo che stai cercando una sola volta nel foglio di lavoro. Poiché è possibile avere molti scenari della parola Sid, non è possibile avere uno solo .Find. Dovrai usare .FindNext. Vedi il link THIS su come usarlo. L'ho spiegato lì, quindi non mi preoccuperò di spiegarlo qui.

Possiamo rendere il nostro .Find più efficiente cercando solo quelle celle che hanno formule. Per fare ciò dobbiamo usare .SpecialCells(xlCellTypeFormulas). Questo spiega perché abbiamo "=" nel nostro esempio in PART1.:)

Ecco un esempio (codice PART1 aggiunto in basso)

Sub Sample() 
    Dim oRange As Range, aCell As Range, bCell As Range 
    Dim oSht As Worksheet 
    Dim strSearch As String, FoundAt As String 

    Set oSht = Worksheets("Sheet1") 

    '~~> Set your range where you need to find - Only Formula Cells 
    On Error Resume Next 
    Set oRange = oSht.Cells.SpecialCells(xlCellTypeFormulas) 
    On Error GoTo 0 

    If Not oRange Is Nothing Then 
     strSearch = "Sid" 

     Set aCell = oRange.Find(What:=strSearch, LookIn:=xlFormulas, _ 
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
        MatchCase:=False, SearchFormat:=False) 

     If Not aCell Is Nothing Then 
      Set bCell = aCell 

      '~~> Check if the cell has named range 
      If isNamedRangePresent(aCell, strSearch) Then FoundAt = aCell.Address 

      Do 
       Set aCell = oRange.FindNext(After:=aCell) 

       If Not aCell Is Nothing Then 
        If aCell.Address = bCell.Address Then Exit Do 

        '~~> Check if the cell has named range 
        If isNamedRangePresent(aCell, strSearch) Then FoundAt = FoundAt & ", " & aCell.Address 
       Else 
        Exit Do 
       End If 
      Loop 
     Else 
      MsgBox SearchString & " not Found" 
      Exit Sub 
     End If 

     If FoundAt = "" Then 
      MsgBox "The Named Range was not found" 
     Else 
      MsgBox "The Named Range has been found these locations: " & FoundAt 
     End If 
    End If 
End Sub 

Function isNamedRangePresent(rng As Range, s As String) As Boolean 
    Dim sFormula As String 
    Dim pos1 As Long, pos2 As Long, sLen As Long, i As Long 

    sFormula = rng.Formula: sLen = Len(sFormula) 

    pos2 = 1 

    Do 
     pos1 = InStr(pos2, sFormula, s) - 1 
     If pos1 < 1 Then Exit Do 

     isNamedRangePresent = True 

     For i = 65 To 90 
      '~~> A-Z before Sid for example XSid 
      If UCase(Mid(sFormula, pos1, 1)) = Chr(i) Then 
       isNamedRangePresent = False 
       Exit For 
      End If 
     Next i 

     '~~> Check for " for example "Sid 
     If isNamedRangePresent = True Then _ 
     If UCase(Mid(sFormula, pos1, 1)) = Chr(34) Then isNamedRangePresent = False 
     '~~> Check for underscore for example _Sid 
     If isNamedRangePresent = True Then _ 
     If UCase(Mid(sFormula, pos1, 1)) = Chr(95) Then isNamedRangePresent = False 

     pos2 = pos1 + Len(s) + 1 

     If pos2 <= sLen Then 
      For i = 65 To 90 
       '~~> A-Z after Sid for example SidX 
       If UCase(Mid(sFormula, pos2, 1)) = Chr(i) Then 
        isNamedRangePresent = False 
        Exit For 
       End If 
      Next i 

      '~~> "Sid 
      If isNamedRangePresent = True Then _ 
      If UCase(Mid(sFormula, pos2, 1)) = Chr(34) Then isNamedRangePresent = False 
      '~~> _Sid 
      If isNamedRangePresent = True Then _ 
      If UCase(Mid(sFormula, pos2, 1)) = Chr(95) Then isNamedRangePresent = False 
     End If 
    Loop 
End Function 

uscita

PHEW !!!

Answer 2

Questo codice crea una copia della cartella di lavoro con i nomi. Quindi passa attraverso e cancella ogni nome nel tuo elenco di nomi dalla cartella di lavoro copiata. Conta il numero di errori di formula nella cartella di lavoro prima e dopo. Se il numero di errori è lo stesso, il nome non è stato utilizzato. Se è diverso, è stato usato il nome.

Mi piace fare questo tipo di test per situazioni davvero complicate come questa. Significa che non devi preoccuparti così tanto di regole complicate per i test. Puoi basare la tua risposta sui risultati.

Poiché il test viene eseguito su una copia, dovrebbe essere sicuro. Assicurati di salvare tutto il tuo lavoro prima però!

Per utilizzare, mettere mettere la vostra lista di nomi in una cartella di lavoro e il nome della gamma con quella lista "NamesToTest":

Poi inserire questo codice nella stessa cartella di lavoro ed eseguirlo:

Sub CheckNameUsage() 
Dim WorkbookWithList As Excel.Workbook 
Dim WorkbookWithNames As Excel.Workbook 
Dim TempWb As Excel.Workbook 
Dim cell As Excel.Range 
Dim NameToCheck As String 
Dim ws As Excel.Worksheet 
Dim ErrorRange As Excel.Range 
Dim ErrorsBefore As Long 
Dim ErrorsAfter As Long 
Dim NameUsed As Boolean 

Set WorkbookWithList = ThisWorkbook 
Set WorkbookWithNames = Workbooks("SO - wb to test.xlsx") 'adjust to suit 
WorkbookWithNames.Worksheets.Copy 'Workbooks.Add(WorkbookWithNames.FullName) 
Set TempWb = ActiveWorkbook 

For Each cell In WorkbookWithList.Names("NamesToTest").RefersToRange.Cells 
    NameToCheck = cell.Value 
    ErrorsBefore = 0 
    For Each ws In TempWb.Worksheets 
     Set ErrorRange = Nothing 
     On Error Resume Next 
     Set ErrorRange = ws.Cells.SpecialCells(xlCellTypeFormulas, 16) 
     On Error GoTo 0 
     If Not ErrorRange Is Nothing Then 
      ErrorsBefore = ErrorsBefore + ErrorRange.Cells.Count 
     End If 
    Next ws 
    TempWb.Names(NameToCheck).Delete 
    ErrorsAfter = 0 
    For Each ws In TempWb.Worksheets 
     Set ErrorRange = Nothing 
     On Error Resume Next 
     Set ErrorRange = ws.Cells.SpecialCells(xlCellTypeFormulas, 16) 
     On Error GoTo 0 
     If Not ErrorRange Is Nothing Then 
      ErrorsAfter = ErrorsAfter + ErrorRange.Cells.Count 
     End If 
    Next ws 
    NameUsed = True 
    If ErrorsBefore = ErrorsAfter Then 
     NameUsed = False 
    End If 
    Debug.Print NameToCheck; " - Errors Before = " & ErrorsBefore; ", Errors After = " & ErrorsAfter; ", Used = " & NameUsed; "" 
Next cell 
TempWb.Close False 
End Sub 

i risultati mostreranno nella finestra Debug:

Il codice è si spera abbastanza auto-esplicativo. SpecialCells merita di essere informato, quindi leggilo se necessario. In questo caso identifica le celle con errori: questo è l'argomento 16.

Si noti che questo controlla solo i nomi a livello di cartella di lavoro. È possibile aggiungere controlli per il livello del foglio di lavoro, se necessario.

Answer 3

Il seguente codice funziona per me. I punti interessanti sono

1) È possibile utilizzare il metodo range.ShowDependents per disegnare frecce alle celle che dipendono da tale intervallo. Al termine, utilizzare range.ShowDependents True per rimuovere le frecce.

2) Una volta che le frecce sono state disegnate, range.NavigateArrow può seguire quelle frecce e restituire l'intervallo risultante. Non sono riuscito a trovare alcuna documentazione su cosa succede se non ci sono intervalli dipendenti. Sperimentando, sono stato in grado di determinare che restituirà l'intervallo originale se non ci sono dipendenti.

Sub test_for_dependents(nm As Name) 
    Dim nm_rng As Range, result As Range 
    Dim i As Long 

    Set nm_rng = nm.RefersToRange 
    nm_rng.ShowDependents 
    Set result = nm_rng.NavigateArrow(False, 1, 1) 
    If result.Parent.Name = nm_rng.Parent.Name And result.Row = nm_rng.Row _ 
     And result.Column = nm_rng.Column Then 
     MsgBox "Named range """ & nm.Name & """ isn't used!" 
    End If 
    nm_rng.ShowDependents True 

    Set nm_rng = Nothing 
    Set result = Nothing 
End Sub 

Sub test_all_names() 
    Dim nm As Name 
    Dim sht As Worksheet 

    For Each nm In ThisWorkbook.Names 
     test_for_dependents nm 
    Next nm 

    For Each sht In ThisWorkbook.Sheets 
     For Each nm In sht.Names 
      test_for_dependents nm 
     Next nm 
    Next sht 

    Set nm = Nothing 
    Set sht = Nothing 
End Sub