VBA通过归类信息实现自动分组

白鹰之约

请论坛VBA大大们帮忙实现下

如图所示，客户需求分为三级，SA,RR,AA；其中SA为最高级客户需求，RR为次级（包含SA信息），AA为末级（包含RR和SA信息）；
当前希望通过VBA实现自动分组，将属于同一个RR下的AA进行组合，同属于一个SA下的RR(含AA）进行组合；
注意实现：
1）如果SA下无RR，直接为下一个SA，则该SA不分组；
2）同理RR

白鹰之约

自己尝试了多次，觉得关键是要如何表示出同类的首行和末尾行，然后通过ROWS（XX:XX）.group来处理，但始终实现不了

yjh_27

参见附件。

山菊花

供参考。

yjh_27

yjh_27 发表于 2020-1-10 23:06
参见附件。

调用分组过程有多种方法，可选择：
按指定字符"."数量分组：'Call AddOutline(arr, 2, 1, ".", "2,2,2")
                             或  Call AddOutline(arr, 2, 1, ".", "2")
按长度分组：'Call AddOutline(arr, 2, 1, 1, "15,6")
按指定首字符分组：Call AddOutline(arr, 2, 1, 6, "SA,RR,*")
                        或  Call AddOutline(arr, 2, 1, 6, "SA,RR,AA")

白鹰之约

yjh_27 发表于 2020-1-10 23:06
参见附件。

非常感谢，很详细，很厉害

白鹰之约

山菊花 发表于 2020-1-11 08:30
供参考。

版主太强大了，代码非常精简干练，版主能分享下思路么？
下面做了一些参数修改，可以将结果更加完善
Sub Zdzh_Click(control As IRibbonControl)
    Call 自动组合
End Sub
Sub 自动组合()
    Dim nRow%, Arr(), Brr(1 To 2)
    nRow = Range("b1048576").End(xlUp).Row
    Arr = Range("b1:b" & nRow).Value
    Application.ScreenUpdating = False
    Range("a1:a" & nRow).EntireRow.ClearOutline
    For i = 2 To nRow
        If Not Arr(i, 1) Like "AA.*" Then
            If Brr(2) > 0 And i - Brr(2) > 1 Then‘此处修改为Brr(2) > 0 And i - Brr(2) > 0
                Range("a" & Brr(2) & ":a" & i - 1).EntireRow.Group
            End If
            If Arr(i, 1) Like "SA.*" And Brr(1) > 0 And i - Brr(1) > 1 （修改为0）Then
                Range("a" & Brr(1) & ":a" & i - 1).EntireRow.Group
            End If
            If Arr(i, 1) Like "SA.*" Then Brr(1) = i + 1
            Brr(2) = i + IIf(Arr(i, 1) Like "RR.*", 1, 2)
        End If
    Next
    Application.ScreenUpdating = True
End Sub

白鹰之约

山菊花 发表于 2020-1-11 08:30
供参考。

里面还有个问题，SA的组合是通过检测下一个SA的行号来实现的，而最后一个SA并没有下一个SA，因此最后一个SA不会自动组合

白鹰之约

白鹰之约 发表于 2020-1-11 20:34
版主太强大了，代码非常精简干练，版主能分享下思路么？
下面做了一些参数修改，可以将结果更加完善
Su ...

代码基本看懂了，但是写代码之前的思路是怎么梳理的呢，我一直卡在如何表达同类的最后一行和起始行怎么实现

山菊花

白鹰之约 发表于 2020-1-11 20:36
里面还有个问题，SA的组合是通过检测下一个SA的行号来实现的，而最后一个SA并没有下一个SA，因此最后一个 ...

看你给出的结果，以为你不要最后的组合。
如果要，可以在末尾加上一个：
nRow = Range("b1048576").End(xlUp).Row+1
Arr = Range("b1:b" & nRow).Value
Arr(nrow,1)="SA."