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

Question

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

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

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

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

任何帮助都非常感谢提前。

标签： excelvbasortingnamed-ranges

Answer 1

获取排序的命名范围

• Named ranges可以是工作簿或工作表范围。

• Names object是所有Name objects按它们排序的集合Name property。

• 如果工作簿中的命名范围引用了不同工作表中的范围，则Workbook object在代码中使用作为参数时可能会得到意外结果。

• 如果所有命名范围都引用一个工作表并且属于任何范围，那么您可以安全地使用Workbook object作为参数的过程。

• 如果您有A1and 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