使用VBA在工作表中获取按顺序排序的所有工作簿范围名称？答案

【问题标题】：Get all Workbook Range Names sorted by Order in Worksheet with VBA?使用VBA在工作表中获取按顺序排序的所有工作簿范围名称？
【发布时间】：2020-12-06 21:24:21
【问题描述】：

我正在将许多表单（可能最终有几十个，一个主模板的所有变体）编码到单独的平面数据库中。每个表单都有超过 2 - 300 个字段，它们是唯一的条目。

在为所有这些字段分配范围名称后，当我使用 Formulas->Use in Formula->Paste Names->List 获得范围名称列表时，我得到了所有命名范围，但它们按字母顺序排序。我需要它们按照它们在数据输入表单中出现的顺序，按行排序，然后按列排序。

通过使用 Right() 和 Left() 函数，我可以从 Range Name Address 中提取行和列值，然后按 Row 和 Column 排序，现在我对 Range Names 进行了排序，以便可以按顺序输入放入一个数组，然后我用它来创建数据库工作表列。

有没有更快的方法来获得这个排序列表结果，而不是将整个过程编码为一个过程？无论是作为公式还是 VBA 函数都没有关系。

非常感谢您提前提供任何帮助。

【问题讨论】：

你能分享你试过的代码吗？另外，您能否更准确地解释您想要的结果是字符串（名称）数组还是范围数组？
工作簿中是否只有您需要的范围名称或其他名称？
很抱歉，除了我所描述的之外，我还没有“尝试过”任何代码。数据输入表单包含大约 300 个命名范围，每个单元格。它们有 OpStartDD、OpStartMMM、OpstartYYYY 等名称。 - 表单中的第一个字段。当我从名称管理器中获得所有命名范围的列表时，它会按字母顺序排列。我使用 =RIGHT(AD3,LEN(AD3)-FIND("$",AD3)) 和 =LEFT(AE3,LEN(AE3)-FIND("$",AE3)) 来提取 Row 和 Column 值，然后将整个列表排序为那些列。现在命名范围按工作表中的顺序排序。我在问是否存在更简单的方法

标签： excel vba sorting named-ranges

【解决方案1】：

获取排序的命名范围

Named ranges 可以属于工作簿或工作表范围。
Names object 是所有Name objects 的集合，按其Name property 排序。
如果您工作簿中的命名范围引用了不同工作表中的范围，如果您在代码中使用Workbook object 作为参数，您可能会得到意想不到的结果。
如果所有命名范围都引用一个工作表并且属于任何范围，那么您可以安全地使用以Workbook object 作为参数的过程。
如果您有A1 和A1:D10，则将使用第一个排序的名称，这可能是A1:D10 的名称（不可接受），可以通过将Set cel = nm.RefersToRange.Cells(1) 替换为：
```
Set cel = nm.RefersToRange
If cel.Cells.count = 1 Then
    ' ...
End If
```

守则

Option Explicit

Function getNamesSortedByRange( _
    WorkbookOrWorksheet As Object, _
    Optional ByVal ByColumns As Boolean = False) _
As Variant
    Const ProcName As String = "getNamesSortedByRange"
    On Error GoTo clearError
    Dim cel As Range
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    Dim arl As Object
    Set arl = CreateObject("System.Collections.ArrayList")
    Dim Key As Variant
    Dim nm As Name
    For Each nm In WorkbookOrWorksheet.Names
        Set cel = nm.RefersToRange.Cells(1)
        If ByColumns Then
            Key = cel.Column + cel.Row * 0.0000001 ' 1048576
        Else
            Key = cel.Row + cel.Column * 0.00001 ' 16384
        End If
        ' To visualize, uncomment the following line.
        'Debug.Print nm.Name, nm.RefersToRange.Address, Key, nm
        If Not dict.Exists(Key) Then ' Ensuring first occurrence.
            dict.Add Key, nm.Name
            arl.Add Key
        End If
    Next nm
    If arl.Count > 0 Then ' or 'If dict.Count > 0 Then'
        arl.Sort
        Dim nms() As String
        ReDim nms(1 To arl.Count)
        Dim n As Long
        For Each Key In arl ' Option Base Paranoia
            n = n + 1
            nms(n) = dict(Key)
        Next Key
        getNamesSortedByRange = nms
    End If

ProcExit:
    Exit Function

clearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "        " & Err.Description
    Resume ProcExit

End Function

Sub TESTgetNamesSortedByRange()
    ' Note that there are no parentheses '()' in the following line,
    ' because the function might return 'Empty' which would result
    ' in a 'Type mismatch' error in the line after.
    Dim nms As Variant
    nms = getNamesSortedByRange(ThisWorkbook)
    If Not IsEmpty(nms) Then Debug.Print Join(nms, vbLf)
    nms = getNamesSortedByRange(ThisWorkbook, True)
    If Not IsEmpty(nms) Then Debug.Print Join(nms, vbLf)
End Sub

【讨论】：