Question

我有一个包含近20张工作簿的594个命名范围的列表，每个工作表有大约200列数据。我需要找出使用命名范围的位置，以便删除不相关的范围。我将一个命名范围列表粘贴到工作表上，然后我尝试通过记录它们来查找是否在公式中使用它们，然后在所有工作表和列中使用find方法。问题是尽管使用了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可以出现在这些表单中的任何一种中，如下图所示。为什么以=开头？这已在下面的Part2中解释过。

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

enter image description here

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

因此，这是一个快速函数，用于检查单元格公式是否具有命名范围。我相信它可以提高效率

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

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

enter image description here

第2部分

现在来.Find。我看到你只在工作表中搜索一次。由于您可以使用单词Sid的许多方案，因此您不能只拥有一个.Find。您必须使用.FindNext。有关如何使用该链接，请参阅THIS链接。我在那里解释过，所以我不打算在这里解释。

我们可以通过仅搜索具有公式的单元格来提高.Find效率。为此，我们必须使用.SpecialCells(xlCellTypeFormulas)。这解释了为什么我们在PART1的示例中有“=”。：）

以下是一个示例（底部添加了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
            '~~> 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

<强>输出

enter image description here

<强>呼!!!

Answer 2

此代码使用名称创建工作簿的副本。然后，它会遍历并删除复制的工作簿中名称列表中的每个名称。它会计算工作簿之前和之后的公式错误数。如果错误计数相同，则不使用该名称。如果它不同，则使用该名称。

我喜欢对这种非常复杂的情况进行这种测试。这意味着您不必担心复杂的测试规则。您可以根据结果找到答案。

由于测试都是在副本上完成的，因此应该是安全的。尽管如此，请务必保存所有工作！

要使用，请将您的名称列表放在工作簿中，并使用该列表“NamesToTest”命名该范围：

enter image description here

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

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

结果将显示在Debug窗口中：

enter image description here

希望代码相当不言自明。 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

查找大工作簿中使用命名范围的位置

3 个答案: