已解决：根据层次关系创建分组

ebom · 发表于 2018-4-19 10:34

本帖最后由 ebom 于 2018-4-21 09:15 编辑

各位大神，求个帮助。
想把如下内容中按照“层次”关系逻辑，实现自动创建分组。先谢谢了

半百 · 发表于 2018-4-19 17:17

Sub test()
Cells.ClearOutline
R = UsedRange.Rows.Count
For I = R To 2 Step -1
If Cells(I, 2) Like "*Y" Then
      If S = Cells(I, 2) Then
         Rows(I + 1 & ":" & R1 - 1).Group
      Else
         S = Cells(I, 2)
         Rows(I + 1 & ":" & R).Group
         R1 = I
      End If
End If
Next
End Sub

ebom · 发表于 2018-4-19 17:29

半百发表于 2018-4-19 17:17
Sub test()
Cells.ClearOutline
R = UsedRange.Rows.Count

非常感谢，不过我这里写的需求有点问题(我的错误）。实际上整个表单可以有好几个1Y，每个1Y是并列的（每个1Y下面再分1和2Y以及其它）。能否再看下，谢谢您的帮助。

半百 · 发表于 2018-4-19 17:41

Sub test()
Cells.ClearOutline
R = UsedRange.Rows.Count
For I = R To 2 Step -1
If Cells(I, 2) Like "*Y" Then

      If S = Cells(I, 2) Then
         Rows(I + 1 & ":" & R1 - 1).Group
      Else
         S = Cells(I, 2)
         Rows(I + 1 & ":" & R).Group
         R1 = I
      End If
End If
If Cells(I, 2) = "1Y" Then R = I - 1
Next
End Sub

ebom · 发表于 2018-4-19 18:03

半百发表于 2018-4-19 17:41
Sub test()
Cells.ClearOutline
R = UsedRange.Rows.Count

非常感谢您的回复。我在顶楼有个“注意项”（每层可能有多个Y或者数字层），所以像这种情况就不对了。您看看能否优化？再次感谢

半百 · 发表于 2018-4-19 20:56

不知道对不对
Sub test()
Cells.ClearOutline
R = UsedRange.Rows.Count
For I = 2 To R
If Cells(I, 2) Like "*Y" Then
For J = I + 1 To R
If J = R Then Rows(I + 1 & ":" & R).Group
      If Cells(J, 2) Like "*Y" Then
         If Cells(J, 2) <= Cells(I, 2) Then
            Rows(I + 1 & ":" & J - 1).Group
            Exit For
         End If
      End If
Next
End If
Next
End Sub