如何按“数字”顺序对大纲数字进行排序？

Question

例如，我想要这 6 个数字。

目前，当我使用排序方法时，它会将 6.6.1.1.13 放在首位，然后将 6.6.1.1.2 放在后面。

排序前

  6.6.1.1
  6.6.1.1.1
  6.6.1.1.13
  6.6.11.14
► 6.6.1.1.2

我希望它在排序后的样子

  6.6.1.1
  6.6.1.1.1
► 6.6.1.1.2
  6.6.1.1.13
  6.6.11.14

Answer 1

不幸的是，唯一完全通用对大纲数字（或更正式地说，“路径索引”）进行排序的方法是使用自定义比较功能。不幸的是，Excel 排序操作和函数不支持这样的功能（甚至不支持 VBA）。 Excel 首选方式是使用自定义列表，但这些不适用于路径索引。

这留下了两个选择：

1. 完全在 VBA 中进行排序：这很有效（我已经完成了），但是非常复杂且混乱。或者，

2. 使用带有 VBA 函数的帮助列：这可行，但并不完全通用，因为您必须提前知道最大索引值是多少。

其中，上面的#2 是迄今为止更简单的选项，但它确实有局限性（如下所述）。

基本上我们想要的是一个 VBA 函数，它可以接受像“6.6.11.14”这样的字符串，并使其始终按路径索引顺序排序。此字符串的问题在于，在文本顺序中，".11" 和 ".14" 等两位数字索引位于 之前 ".2" 而不是之后。

解决此问题的明显方法是将所有索引转换为带有前导零的 2 位数字。因此，6.6.11.14 将变为 06.06.11.14，至关重要的是，6.6.2.1 将变为 06.06.02.01。现在这两个路径索引值将使用文本排序正确排序。

然而，问题在于 只有当每个单独的索引号从不大于两位数时，这才是正确的 (99)。因此，06.07.99 排序正确，但 06.07.110 在此方案下不是。只需将其从两位数提高到三位数即可轻松解决此问题，但问题是您必须提前知道这一点。

因此，假设我们提前知道任何单个索引号的最大大小/（位数），我们可以使用以下 VBA 函数重新格式化帮助列的大纲数字：

Public Function OutlineSortingFormat(OutlineNumber As String, Digits As Integer) As String
    Dim PathIndexes() As String
    Dim Zeroes As String
    Dim i As Integer
    
    Zeroes = "0000000000"
    
    PathIndexes = Split(OutlineNumber, ".")
    
    For i = 0 To UBound(PathIndexes)
        PathIndexes(i) = Right(Zeroes & PathIndexes(i), Digits)
    Next i
    
    OutlineSortingFormat = Join(PathIndexes, ".")
End Function

这只是将大纲编号拆分为单独的数字字符串，在正确数量的零前面加上前缀，然后将它们连接回可排序的大纲编号。

然后，您可以通过创建一个辅助列并使用如下函数来应用它：

=OutlineSortingFormat(M3,2)

M 是包含未格式化大纲索引的列，第二个参数 (, 2)) 表示您希望将所有索引号填充（并截断）为 2 位数字。然后，不要对原始大纲数字进行排序，而是对包含重新格式化的值的“帮助列”进行排序。

Answer 2

手动方法

使用文本到列功能并使用“。”分隔标题。作为分隔符。

完成后选择所有数据，如下所示：

对选定的数据进行排序。

注意：我的数据已选择标题，并且第 6 列和第 7 列出现 A 到 Z，因为它们当前为空，因此默认为字母排序。可以通过在要排序的数据的开头或结尾添加一个虚拟数据行来添加字母排序。这是通过将全 0 或大于列表中任何数字的数字添加到所有列来完成的。

选择确定后，您的“组合”数据将根据右侧的大纲数字进行数字排序。

Answer 3

这里有一些用于多种用途的代码。

第一个函数是一个 UDF，如果需要，可以从工作表中调用它以用作辅助函数。因此，如果需要排序，可以很容易地更改焊盘长度。

第二个代码涉及更多一点，但在表格旁边插入一列，添加辅助函数，排序然后删除辅助列以保留工作表结构。

SortColumn 应该定义为索引所在的列索引。即如果在指定表的第一列中，那么它将被设置为'1'

Public Function PadIndices(Cell As Range, PadLength As Long, Optional Delimiter As String) As String
    If Cell.Count > 1 Then Exit Function
    If Delimiter = "" Then Delimiter = "."
    
    Dim Arr As Variant: Arr = Split(Cell.Value, Delimiter)
    Dim i As Long: For i = LBound(Arr) To UBound(Arr)
        If Len(Arr(i)) < PadLength Then Arr(i) = WorksheetFunction.Rept("0", PadLength - Len(Arr(i))) & Arr(i)
    Next i
    PadIndices = Join(Arr, Delimiter)
End Function

Sub SortByIndices()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
    
    Dim Table As Range: Set Table = ws.Range("H7:I11")
    Dim PadLength As Long: PadLength = 2
    Dim SortColumn As Long: SortColumn = 1
    
    Table.Columns(1).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
    Dim SortRange As Range: Set SortRange = Table.Columns(1).Offset(0, -1)
    SortRange.Formula2R1C1 = "=PadIndices(RC[" & SortColumn & "], " & PadLength & ")"
    
    With ws.Sort.SortFields
        .Clear
        .Add2 Key:=SortRange, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    End With
    
    With ws.Sort
        .SetRange Application.Union(Table, SortRange)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    SortRange.Delete Shift:=xlToLeft
    
End Sub

Answer 4

您可以创建一个辅助列，在其中删除点并对辅助列进行排序。

=NUMBERVALUE(SUBSTITUTE(E4;".";))

Answer 5

A) 无需帮助栏的用户定义函数

为了能够对大纲数字进行排序，您必须带上各个数值 到一个明确定义的统一数字格式 （例如"00"，如果假定默认数字不超过99；注意b)部分中灵活的String()函数)。

这种动态数组方法允许任何 范围定义（加上可选 数字最大值）的参数输入，例如

• =Outline(A5:A10) 对一列进行排序（默认最大值为 2 位）甚至
• =Outline(A2:E4, 3) 在多列范围内（明确最大为 3 位）

注意： 已使用 Office 2019+/MS365 的较新动态功能进行测试； 为了向后兼容，您必须更改 TextJoin() 函数，并可能使用 CSE (Ctrl+Shift+Enter) 将 =Outline(...) 作为数组公式输入。

Function Outline(rng As Range, Optional ByVal digits As Long = 2)
'Date: 2022-01-09
'Auth: https://stackoverflow.com/users/6460297/t-m
'a) create unordered 1-dim array from any contiguous range
    Dim myFormula As String
    myFormula = "TextJoin("","",True," & rng.Address(False, False) & ")"
    Dim codes
    codes = Split(rng.Parent.Evaluate(myFormula), ",")
'b) add leading zeros via number format
    Dim i As Long
    For i = LBound(codes) To UBound(codes)
        Dim tmp: tmp = Split(codes(i), ".")
        Dim ii As Long
        For ii = LBound(tmp) To UBound(tmp)
            tmp(ii) = Format(CInt(tmp(ii)), String(digits, "0"))
        Next ii
        codes(i) = Join(tmp, ".")   ' join to entire string element
        Debug.Print i, codes(i)
    Next i
'c) sort
    BubbleSort codes                ' << help proc BubbleSort
'd) remove leading zeros again
    For i = LBound(codes) To UBound(codes)
        For ii = 1 To digits - 1    ' repeat (digits - 1) times
            codes(i) = Replace(codes(i), ".0", ".")
            If Left(codes(i), 1) = "0" Then codes(i) = Mid(codes(i), 2)
        Next
    Next
'e) return function result
    Outline = Application.Transpose(codes)
End Function

帮助程序BubbleSort

Sub BubbleSort(arr)
'Date: 2022-01-09
'Auth: https://stackoverflow.com/users/6460297/t-m
    Dim cnt As Long, nxt As Long, temp
    For cnt = LBound(arr) To UBound(arr) - 1
        For nxt = cnt + 1 To UBound(arr)
            If arr(cnt) > arr(nxt) Then
                temp = arr(cnt)
                arr(cnt) = arr(nxt)
                arr(nxt) = temp
            End If
        Next nxt
    Next cnt
End Sub

---

B) 只是为了好玩：替代单一公式方法 （数字范围有限）

我没有扩展数字格式，而是尝试限制数字显示 通过执行临时十六进制替换。

注意，此方法基于单一公式评估 只允许在 1 到 15 的数字范围内的轮廓子编号（因为数字 10 到 15 被字符 A 到 F 替换），但对于低层次深度可能就足够了！此外，它还包括一个表格Sort() 函数，仅在 Excel 版本 MS365 中可用！

Function Outline(rng As Range)
'Site: https://stackoverflow.com/questions/70565436/how-to-sort-outline-numbers-in-numerical-order
'Date: 2022-01-09
'Auth: https://stackoverflow.com/users/6460297/t-m
'Meth: hex replacements + sort; assuming chapters from (0)1 to 15 (10=A,11=B..15=F)
'Note: allows outline sub-numbers only up to 15! Needs Excel version MS365.
    Dim pattern
    pattern = String(6, "X") & "Sort(" & String(6, "X") & "$,15,""F""),14,""E""),13,""D""),12,""C""),11,""B""),10,""A"")),""A"",10),""B"",11),""C"",12),""D"",13),""E"",14),""F"",15)"
    pattern = Replace(Replace(pattern, "$", rng.Address(False, False)), "X", "Substitute(")
    Outline = rng.Parent.Evaluate(pattern)
End Function