1

例如，我想要这 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
4

5 回答 5

4

不幸的是，对大纲数字（或更正式地说，“路径索引”）进行排序的唯一完全通用的方法是使用自定义比较功能。不幸的是，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 位数字。然后，不是对原始大纲数字进行排序，而是对包含重新格式化的值的“帮助列”进行排序。

在此处输入图像描述

于 2022-01-03T14:13:03.103 回答
2

手动方式

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

在此处输入图像描述

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

在此处输入图像描述

对所选数据执行排序。

在此处输入图像描述

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

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

在此处输入图像描述

于 2022-01-03T14:16:34.590 回答
1

这是一些用于多种目的的代码。

第一个函数是一个 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
于 2022-01-06T21:36:22.387 回答
0

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

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

在此处输入图像描述

于 2022-01-03T12:38:59.487 回答
0

A) 无需帮助栏的用户定义功能

为了能够对大纲数字进行排序，您必须将各个数值转换为明确定义的统一数字格式 （例如"00"，如果数字不超过 99 作为假定的默认值；请注意节中的灵活String()功能b)）。

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

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

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

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
于 2022-01-09T19:46:45.690 回答