Finden, wo benannte Bereiche in großen Arbeitsmappe

Question

verwendet werden Ich habe eine Liste von 594 benannten Bereichen in einer Arbeitsmappe mit fast 20 Blatt, jedes Blatt hat etwa 200 Datenspalten. Ich muss herausfinden, wo die benannten Bereiche verwendet werden, um irrelevante Bereiche zu entfernen. Ich habe eine Liste mit benannten Bereichen in das Blatt eingefügt und dann versucht, herauszufinden, ob sie in einer Formel verwendet wurden, indem ich sie aufgezeichnet habe, und dann die Methode find in allen Blättern und Spalten verwendet. Das Problem besteht trotz der Verwendung von lookin xlformulas, es ruft den benannten Bereich ab, auch wenn es nur ein Text ist.

Hier ist mein (aktualisiert) Versuch (wenn es bereits nicht ersichtlich ist, ich bin ein Amateur):

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

Hier ist eine Möglichkeit, die ich denken kann. Ich werde das in 2 Teilen erklären.

TEIL 1

Lassen Sie uns sagen, dass wir einen benannten Bereich Sid haben.

Dieses Wort Sid kann in einer der folgenden Formen angezeigt werden, wie in der folgenden Abbildung dargestellt. Warum beginnt es mit =? Dies wurde unten in Part2 erklärt.

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

Alle anderen Szenarien, denke ich werde eine Teilmenge der oben sein. Jetzt ist der einzige gültige Fund in unserem Fall der erste und der letzte, seit wir nach unserer benannten Reihe suchen.

Also hier ist eine schnelle Funktion, um zu überprüfen, ob die Zellenformel einen benannten Bereich hat oder nicht. Ich bin sicher, es kann mehr

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 

So in der ersten und letzten Fall effizienter gemacht werden, wird Debug.Print isNamedRangePresent(Range("D2"), "Sid") geben Sie dieses

TEIL 2

Jetzt True anzeigen Kommen zu der .Find. Ich sehe, dass Sie nur einmal im Arbeitsblatt suchen. Da Sie viele Szenarien des Worts Sid haben können, können Sie nicht nur eine .Find haben. Sie müssen .FindNext verwenden. Siehe THIS Link, wie man das benutzt. Ich habe es dort erklärt, also werde ich das hier nicht erklären.

Wir können unsere .Find effizienter machen, indem Sie nur die Zellen suchen, die Formeln haben. Dazu müssen wir .SpecialCells(xlCellTypeFormulas) verwenden. Dies erklärt, warum wir in unserem Beispiel in PART1 "=" hatten.:)

Hier ist ein Beispiel (PART1-Code am unteren Rand hinzugefügt)

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 

Ausgabe

PHEW !!!

Answer 2

Dieser Code erstellt eine Kopie der Arbeitsmappe mit den Namen. Es wird dann ausgeführt und löscht alle Namen in der Liste der Namen aus der kopierten Arbeitsmappe. Es zählt die Anzahl der Formelfehler in der Arbeitsmappe vor und nach. Wenn die Anzahl der Fehler gleich ist, wurde der Name nicht verwendet. Wenn es anders ist, wurde der Name verwendet.

Ich mache gerne diese Art von Test für wirklich komplizierte Situationen wie diese. Es bedeutet, dass Sie sich nicht so viele Gedanken über komplizierte Testregeln machen müssen. Sie können Ihre Antwort nur auf die Ergebnisse stützen.

Da alle Tests auf einer Kopie durchgeführt werden, sollte es sicher sein. Stellen Sie sicher, dass Sie Ihre gesamte Arbeit speichern.

nutzen zu können, setzen Sie Ihre Liste von Namen in einer Arbeitsmappe setzen und den Bereich mit der Liste „NamesToTest“ nennen:

Dann diesen Code in derselben Arbeitsmappe setzen und ausführen:

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 

die Ergebnisse im Debug-Fenster zeigt:

Der Code ist hoffentlich ziemlich selbsterklärend. SpecialCells ist es wert, darüber informiert zu werden, also lesen Sie es bei Bedarf nach. In diesem Fall identifiziert es Zellen mit Fehlern - das ist das Argument 16.

Beachten Sie, dass dies nur nach Namen auf Arbeitsmappenebene überprüft. Sie können bei Bedarf Prüfungen für Arbeitsblatt-Ebene hinzufügen.

Answer 3

Der folgende Code funktioniert für mich. Die interessanten Punkte sind

1) Sie können die Methode range.ShowDependents verwenden, um Pfeile auf Zellen zu zeichnen, die von diesem Bereich abhängig sind. Wenn Sie fertig sind, verwenden Sie range.ShowDependents True, um die Pfeile zu entfernen.

2) Sobald die Pfeile gezeichnet sind, kann range.NavigateArrow diesen Pfeilen folgen und den resultierenden Bereich zurückgeben. Ich konnte keine Dokumentation darüber finden, was passiert, wenn es keine abhängigen Bereiche gibt. Durch Experimente konnte ich feststellen, dass es den ursprünglichen Bereich zurückgibt, wenn keine Abhängigen vorhanden sind.

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