使用VBA获取按工作表中的订单排序的所有工作簿范围名称? [英] Get all Workbook Range Names sorted by Order in Worksheet with VBA?

问题描述

我正在将多种形式(可能最终是数十种，一个主模板的所有变体)编码到单独的平面数据库中.每个表单都有2-300个字段，这些字段是唯一条目.

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.

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

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.

通过使用Right()和Left()函数，我可以从范围名称地址中提取行和列的值，然后依次对行和列进行排序，现在我对范围名称进行了排序，因此可以依次输入放入数组中，然后用它来创建数据库工作表列.

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.

是否有一种更快的方法来获得此排序列表结果，而没有将整个过程编码为过程?作为公式还是VBA函数都没有关系.

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.

推荐答案

获取排序的命名范围

• Get Sorted Named Ranges

  • Named ranges can be of workbook- or worksheet-scope.

    名称对象 是所有 的集合名称对象 按其 名称属性 .

    如果工作簿中的命名范围引用了不同工作表中的范围，那么如果在代码中使用 Workbook对象作为参数，则可能会得到意外的结果.

    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.

    如果所有命名的范围都引用一个工作表且具有任何范围，则可以安全地使用以 Workbook对象作为参数的过程.

    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.

    如果您具有 A1 和 A1:D10 ，则将使用第一个排序的名称，该名称可能是 A1:D10 (不可接受)，可以通过将 Set cel = nm.RefersToRange.Cells(1)替换为:

    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
    

  代码

  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
  

  这篇关于使用VBA获取按工作表中的订单排序的所有工作簿范围名称?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！