如何根据父阶规则批量分组？

hoooyooo000

如图，B列已按规则A-B-C-D填写好了，一共有4级，如何让A为1级、B为2级、C为3级、D为4级批量进行分组呢？

lgs2296129235

完全没懂你想要啥

hoooyooo000

lgs2296129235 发表于 2020-9-18 15:22
完全没懂你想要啥

就是如下格式：
100
100-1
100-1-1
200
200-1
200-1-1
200-1-1-a
有几千行，按100和200、300、400...为第1组，往下一阶100-1、200-1....为第2组，以此类推

yjh_27

BOM 大纲排序-自定义函数
http://club.excelhome.net/thread-1175717-1-1.html
(出处: ExcelHome技术论坛)

一把小刀闯天下

'没看懂先猜一个，按层级升序，，，

Option Explicit

Sub test()
  Dim arr, i, j, t
  arr = Range("a3:b" & Cells(Rows.Count, "b").End(xlUp).Row).Resize(, 9).Value
  For i = 3 To UBound(arr, 1)
    t = Split(Replace(arr(i, 2), Space(1), vbNullString), "-")
    arr(i, 9) = Format(UBound(t), String(5, "0"))
    For j = 0 To UBound(t)
      arr(i, 9) = arr(i, 9) & "-" & Format(t(j), String(5, "0"))
    Next
    For j = j To 4
      arr(i, 9) = arr(i, 9) & "-" & String(5, "0")
    Next
  Next
  Call qsort(arr, 3, UBound(arr, 1), 2, 9, 9)
  [j3].Resize(UBound(arr, 1), UBound(arr, 2) - 1) = arr
End Sub

Function qsort(arr, first, last, left, right, key)
  Dim i As Long, j As Long, k As Long, x As String, t As String
  i = first: j = last: x = arr((first + last) / 2, key)
  While i <= j
    While StrComp(arr(i, key), x, vbTextCompare) = -1: i = i + 1: Wend
    While StrComp(x, arr(j, key), vbTextCompare) = -1: j = j - 1: Wend
    If i <= j Then
      For k = left To right
        t = arr(i, k): arr(i, k) = arr(j, k): arr(j, k) = t
      Next
      i = i + 1: j = j - 1
    End If
  Wend
  If first < j Then qsort arr, first, j, left, right, key
  If i < last Then qsort arr, i, last, left, right, key
End Function

准提部林

ubound(split("101-1-a", "-")) +1
即為层級???

hoooyooo000

一把小刀闯天下 发表于 2020-9-19 04:14
'没看懂先猜一个，按层级升序，，，

Option Explicit

非常感谢，可能是我没表达清楚。批量实现如下图的功能：【数据】-【创建组】

yjh_27

hoooyooo000 发表于 2020-9-19 14:26
非常感谢，可能是我没表达清楚。批量实现如下图的功能：【数据】-【创建组】

1. Sub aa()
   
2. r = Range("a" & Rows.Count).End(xlUp).Row
   
3. arr = Range("a5:b" & r)
   
4. 
   
5. Call AddOutline(arr, 5, 2, "-")
   
6. End Sub
   

复制代码

AddOutlin 见4L链接