Группировка строк в Excel с одинаковыми значениями

Question

У меня есть таблица с первым столбцом, содержащим несколько чисел, и я хочу просмотреть и сгруппировать строки моей таблицы на основе значений в этом первом столбце, чтобы они могли быть разборными.Так похоже на то, что делает shift + alt + right.В качестве примера я хотел бы преобразовать таблицу со строками, подобными этой

1

1

2

3

3

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

Ниже приведена картинка, показывающая, каков результат выполнения кода

результат выполнения кода

Надеюсь, я был полезен. Привет

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

не проверен, но должен привести соответствующий пример.