按序号为分级显示自动创建组 按分级显示的组合自动编序号

tanghaixiong

不过，跟我们内部的还是不一样，不知道各位高手能否帮忙下。这边的层级最多到6，7级，一层最多到20个

yjh_27

tanghaixiong 发表于 2015-5-29 11:05
不过，跟我们内部的还是不一样，不知道各位高手能否帮忙下。这边的层级最多到6，7级，一层最多到20个

参见附件。


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

1226845687

感谢yjh_27在两年前分享的“按序号为分级显示自动创建组”VBA模块，在使用中发现一个小问题，当序号如下时，会把1.2之下全部化为一组，麻烦抽空测试和修改一下。我的邮箱chen5401675@163.com,谢谢。
1
1.1
1.1.1
1.1.2
1.1.3
1.2
1.3
1.4
1.4.1
1.4.2

yjh_27

1226845687 发表于 2016-4-10 10:32
感谢yjh_27在两年前分享的“按序号为分级显示自动创建组”VBA模块，在使用中发现一个小问题，当序号如下时 ...

一键分组、分级

树状BOM
http://club.excelhome.net/thread-1272129-1-1.html
(出处: ExcelHome技术论坛)

人生如游戏

谢谢分享，学习了，支持一个！！

Flyin

谢谢yjh_27大侠，支持一个！！

pati

非常感谢楼主，通过这帖解决了我的大问题。

但在使用中发现有如下问题：
举例说明：
如果序号列是这样分布：
1.1.1
1.2
1.3
1.3.1
那么1.3这一行，会被归到1.3.1这一级，出现错误。
经排查，可将1L附件2中 sub aa（）第12行，

1. If UBound(sfji) > ji Then

复制代码

修改为  

1.   If UBound(sfji) >＝ ji Then

复制代码

最终就是：

1. Sub aa()
   
2. Dim brr(7)
   
3. r = Range("a" & Rows.Count).End(xlUp).Row
   
4. 
   
5. arr = Range("a1:a" & r)
   
6. 
   
7. ji = 0
   
8. brr(0) = 2    '起始行
   
9. Range(Cells(brr(ji) + 1, 1), Cells(UBound(arr, 1), 1)).ClearOutline
   
10. For i = brr(0) To UBound(arr, 1)
    
11.     sfji = Split(arr(i, 1), ".")
    
12.     If UBound(sfji) >＝ ji Then
    
13.         ji = UBound(sfji)
    
14.         jiw = 0
    
15.         brr(ji) = i
    
16.     ElseIf UBound(sfji) < 0 Then
    
17.         jiw = 1
    
18.     ElseIf UBound(sfji) < ji Or jiw = 1 Then
    
19.         If jiw = 1 Then
    
20.             Range(Cells(brr(ji) + 1, 1), Cells(i - 1, 1)).Rows.Group
    
21.             brr(ji) = i
    
22.             jiw = 0
    
23.         End If
    
24.         Do While UBound(sfji) < ji
    
25.             ji = ji - 1
    
26.             Range(Cells(brr(ji) + 1, 1), Cells(i - 1, 1)).Rows.Group
    
27.             brr(ji) = i
    
28.         Loop
    
29.     End If
    
30. Next
    
31. Do While ji > 0
    
32.     ji = ji - 1
    
33.     Range(Cells(brr(ji) + 1, 1), Cells(i - 1, 1)).Rows.Group
    
34. Loop
    
35. 
    
36. End Sub
    

复制代码

问题解决。再次感谢楼主。

ebom

楼主，帮看看这个帖子吧，关于自动分组的，你原来的代码解决不了，所以才求助你了。
http://club.excelhome.net/thread-1363279-1-1.html

演过春归

感谢楼主！！非常实用！

djwang1988

太好用了！！