查找大工作簿中正在使用的命名范围

我有一个工作簿中有近59个命名范围的列表，有近20张，每张有大约200列的数据。 我需要找出命名范围在哪里被使用，以删除不相关的范围。 我将一个命名区域列表粘贴到表单上，然后尝试通过logging来查找它们是否在公式中使用，然后在所有表单和列中使用find方法。 问题是，尽pipe使用了lookin xlformulas，它仍然检索命名范围，即使它只是一个文本。

这是我的（更新）尝试（如果它不是已经很明显，我是一个业余）：

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

这是我能想到的一个方法。 我将分两部分来解释。

第1部分

假设我们有一个命名范围Sid 。

这个单词Sid可以以下面的图片中的任何一种forms出现。 为什么以=开头？ 这在Part2已经解释过了。

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

任何其他情况下，我想将是上述的一个子集。 现在，在我们的案例中唯一有效的发现是第一个和最后一个，因为我们正在寻找我们的命名范围。

所以这里有一个快速的函数来检查单元格公式是否有命名的范围。 我相信它可以变得更有效率

 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 '~~> AZ 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 '~~> AZ 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 

所以在第一个和最后一个例子中， Debug.Print isNamedRangePresent(Range("D2"), "Sid")会给你True

第2部分

现在来找。find。 我发现你在工作表中只search一次。 既然你可以有很多Sid这个单词存在的场景，你不能只有一个.Find 。 你将不得不使用.FindNext 。 看到这个链接如何使用。 我已经在那里解释了，所以我不打扰在这里解释。

我们可以通过只search那些有公式的单元格来使我们的查找更有效率。 要做到这一点，我们必须使用.SpecialCells(xlCellTypeFormulas) 。 这就解释了为什么我们在第一部分的例子中有“=”。 🙂

这里是一个例子（在底部添加PART1代码）

 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 '~~> AZ 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 '~~> AZ 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 

产量

唷！

Answer 2

此代码使用名称创build工作簿的副本。 然后，它会从复制的工作簿中删除名称列表中的每个名称。 它会计算工作簿之前和之后的公式错误的数量。 如果错误计数相同，则不使用该名称。 如果不一样，就使用这个名字。

我喜欢为这样的复杂情况做这种testing。 这意味着您不必担心复杂的testing规则。 你可以把你的答案基于结果。

由于testing全部在副本上完成，所以应该是安全的。 一定要保存所有的工作！

为了使用，把你的名字列表放在一个工作簿中，并命名该名单“NamesToTest”的范围：

然后将这些代码放在同一个工作簿中并运行它：

 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 

结果将显示在“debugging”窗口中：

代码是希望相当自我解释。 SpecialCells值得了解，如有必要，请阅读。 在这种情况下，它识别有错误的单元格 – 这是16个参数。

请注意，这只会检查工作簿级别的名称。 如有必要，您可以添加工作表级别的检查。

Answer 3

以下代码适用于我。 有趣的一点是

1）您可以使用方法range.ShowDependents将箭头绘制到依赖于该范围的单元格中。 完成后，使用range.ShowDependents True删除箭头。

2）一旦箭头被绘制， range.NavigateArrow可以跟随这些箭头，并返回结果范围。 如果没有依赖范围，我找不到任何文档。 通过实验，我能够确定，如果没有家属，它会返回原来的范围。

 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