Question

我有一个表，第一列包含一些数字，我想根据第一列中的值循环遍历并分组表中的行，以便它们可以折叠。因此与shift + alt + right相似。举例来说，我要转换具有这样的行的表

1

2

3

到这样的表中，每个分组都可以在同一级别展开。

1

2

3

我一直在尝试更改从https://superuser.com/questions/867796/excel-macro-to-group-rows-based-on-a-cell-value中找到的宏。我当前的宏是...

Dim LastRow As Integer
LastRow = ActiveSheet.UsedRange.Rows.Count
Dim StartRow As Integer
StartRow = 8

groupBegin = StartRow 'For the first group
For i = StartRow To LastRow

    If Cells(i, 1).Value <> Cells(i + 1, 1).Value Then
        groupEnd = i - 1
        Rows(groupBegin & ":" & groupEnd).Select
        Selection.Rows.Group
        groupBegin = i + 1 'adding one to keep the group's first row
    End If

Next i

Rows(groupBegin & ":" & LastRow).Select
Selection.Rows.Group

ActiveSheet.Outline.ShowLevels RowLevels:=1 'Minimize all the groups

但是，这会将所有行分组在一起。任何有关如何实现这一目标的指导将不胜感激。

Answer 1

下面是执行任务的代码。请注意，该代码假定数字已排序并且行之间没有空格。

Sub Group_Similar_Rows()

Dim i As Long
Dim lRef_Number As Long
Dim lNumber As Long
Dim lCount As Long
Dim lStarting_Row As Long
Dim lDate_Column As Long
Dim wks As Worksheet

lStarting_Row = 1 ' Change this to the starting row of your data
lDate_Column = 1 ' Chnage this to the column index of your data

Set wks = ThisWorkbook.ActiveSheet

lRef_Number = wks.Cells(lStarting_Row, lDate_Column)

lCount = -1
For i = 0 To 100000 ' if your data entry is more than 100,000 increase this the value

    If wks.Cells(lStarting_Row + i, lDate_Column) = "" And lCount <= 0 Then
        Exit For
    End If

    lCount = 1 + lCount
    lNumber = wks.Cells(lStarting_Row + i, lDate_Column)

    If lNumber <> lRef_Number Then

        lRef_Number = wks.Cells(lStarting_Row + i, lDate_Column)

        If i > 1 Then
            lCount = lCount - 1
        End If

        If lCount > 0 Then
            lCount = 1 + lCount
            wks.Rows(lStarting_Row + i - lCount & ":" & lStarting_Row + i - 2).Group

        End If

        lCount = 0

    End If

Next i

End Sub

下面的图片显示了运行代码的结果

result of running the code

希望我有帮助。问候

Answer 2

我的评论示例

dim i as long, j as long
for i = 10 to 1 Step -1
    if not cells(i,1).value = cells(i-1,1).value then rows(i).insert
next i
for j = 1 to 10
    if cells(j,1).value <> "" then rows(j).group
next j

未经测试，但应提供适当的示例。

将具有相似值的Excel中的行分组

2 个答案: