怎么让excel按序号自动分组【已解决】

feng1989

liulang0808 发表于 2014-2-26 15:23
你在看看这个附件，根据“.”进行拆分的

1.zip (18.03 KB, 下载次数: 127)

2014-2-26 22:25 上传

点击文件名下载附件

请看附件，谢谢！应该是我说错了！

liulang0808

feng1989 发表于 2014-2-26 22:26
请看附件，谢谢！应该是我说错了！

从附件里没有看出要干什么的

feng1989

liulang0808 发表于 2014-2-26 22:36
从附件里没有看出要干什么的

这个，最左边不是有分组的？点+号可以展开下层明细！

liulang0808

feng1989 发表于 2014-2-27 10:55
这个，最左边不是有分组的？点+号可以展开下层明细！

你这个，不不太会，你重启一贴，针对你这个问题咨询吧

liulang0808

你的意思是不是指A列里的啊？

yjh_27

feng1989 发表于 2014-2-26 22:26
请看附件，谢谢！应该是我说错了！

请移步


l按序号自动分级显示
http://club.excelhome.net/thread-1098513-1-1.html

表1是自动分级显示，没做按钮，自己做吧。

feng1989

liulang0808 发表于 2014-2-27 11:01
你的意思是不是指A列里的啊？

是按序号自动分级！

feng1989

yjh_27 发表于 2014-2-27 11:33
请移步

自动删除……提示触发防病毒什么的……

yjh_27

feng1989 发表于 2014-2-27 11:40
自动删除……提示触发防病毒什么的……

你的系统不让用宏，你继续手动吧。

代码如下：

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

复制代码

liulang0808

feng1989 发表于 2014-2-27 11:39
是按序号自动分级！

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    arr = Sheets(1).UsedRange
    l1 = 2
    For j = 2 To UBound(arr)
        If Len(arr(j, 1)) > 0 Then
             r = Sheets(UBound(Split(arr(j, 1), ".")) + 2).Cells.Find("*", , , , 1, 2).Row
            Sheets(1).Range("a" & j & ":p" & j).Copy Sheets(UBound(Split(arr(j, 1), ".")) + 2).Cells(r, 1).Offset(1, 0)
            l1 = j
        Else
            r = Sheets(UBound(Split(arr(l1, 1), ".")) + 2).Cells.Find("*", , , , 1, 2).Row
            Sheets(1).Range("a" & j & ":p" & j).Copy Sheets(UBound(Split(arr(l1, 1), ".")) + 2).Cells(r, 1).Offset(1, 0)
        End If
    Next j
    Application.ScreenUpdating = True
End Sub