我正在将多种形式(可能最终是数十种，一个主模板的所有变体)编码到单独的平面数据库中.每个表单都有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获取按工作表中的订单排序的所有工作簿范围名称?
发布评论