Get all Workbook Range Names sorted by Order in Worksheet with VBA?

问题

I am coding a number of forms (possibly ultimately many dozens, all variants of one main template) into separate flat databases. Each form has over 2 - 300 fields that are unique entries.

After assigning range names to all these fields, when I get a list of Range Names using the Formulas->Use in Formula->Paste Names->List, I get all the Named Ranges but they are sorted alphabetically. I need these in the order they appear in the Data Entry Form, sorted by row, then column.

By using the Right() and Left() functions I can extract the row and column values from the Range Name Address, then sort on the Row then Column, and now I have the Range Names sorted so they can be sequentially entered into an array, which I then use to create the database worksheet columns.

Is there a faster way to get to this sorted list result, short of coding the whole process as a Procedure? Whether as a Formula or a VBA function does not matter.

Any assistance is much appreciated in advance.

回答1:

Get Sorted Named Ranges

Named ranges can be of workbook- or worksheet-scope.
The Names object is a collection of all Name objects sorted by their Name property.
If the named ranges in your workbook refer to ranges in different worksheets, you might get unexpected results if you use the Workbook object as the parameter in the code.
If all named ranges refer to one worksheet and are of any scope, then you can safely use the procedure with the Workbook object as the parameter.
If you have A1 and A1:D10, then the first sorted name will be used which might be the name for A1:D10 (unacceptable) which could be remedied by replacing Set cel = nm.RefersToRange.Cells(1) with:
```
Set cel = nm.RefersToRange
If cel.Cells.count = 1 Then
    ' ...
End If
```

The Code

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

来源：https://stackoverflow.com/questions/65173244/get-all-workbook-range-names-sorted-by-order-in-worksheet-with-vba

标签

excel

vba

sorting

named-ranges