如何根据列内的级别创建分组，大侠帮帮小弟！

mrshz

论坛各位大侠，如何根据E列 对应的级别   创建分组，请帮帮小弟，谢谢各位大侠了

anzequ

要先对E列进行排序才可以分组的

mrshz

anzequ 发表于 2018-7-30 21:02
要先对E列进行排序才可以分组的

没法先排序的啊！

mrshz

其他会代码的大侠，帮帮小弟啊

yjh_27

mrshz 发表于 2018-7-30 21:26
其他会代码的大侠，帮帮小弟啊

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

jiaxinl

mrshz 发表于 2018-7-30 21:26
其他会代码的大侠，帮帮小弟啊

下午有空了写一下，3有三种呈现方式
分组、图形绘制、菜单方式

fsq119

Sub 分级汇总()
ReDim Str(1 To 3), s(1 To 3)
s(1) = "选中“级数”起始单元格"
s(2) = "选中“值”所在列单元格"
s(3) = "选中“结果”所在列单元格"
For i = 1 To 3
Str(i) = Application.InputBox(s(i), Type:=8).Address
With CreateObject("vbscript.regexp")
If i = 1 Then
    .Pattern = ".+(\d+)"
    qd = Val(.Replace(Str(1), "$1"))
End If
.Pattern = "^\$([A-Z]+).*"
Str(i) = .Replace(Str(i), "$1")
End With
Next
c_ji = Str(1)
c_zhi = Str(2)
c_xie = Str(3)
zd = Range(c_ji & 65536).End(xlUp).Row
Set dic = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
Cells.ClearOutline
For i = qd To zd
    j_now = Range(c_ji & i)
    j_next = Range(c_ji & i + 1)
    ActiveSheet.Rows(i).OutlineLevel = j_now
    If j_now < j_next Then
        dic(i) = j_now
    ElseIf j_now > j_next Then
        arr = dic.keys
        For j = UBound(arr) To LBound(arr) Step -1
            If dic(arr(j)) < j_next Then Exit For
            With Range(c_xie & arr(j))
                .Formula = "=subtotal(9," & c_xie & arr(j) + 1 & ":" & c_xie & i & ")"
            End With
            dic.Remove arr(j)
        Next
    End If
Next
ActiveSheet.Outline.SummaryRow = xlAbove
Columns(c_xie).Clear
Set dic = Nothing
Application.ScreenUpdating = True
End Sub