在 Excel 中对具有相似值的行进行分组答案

【问题标题】：Grouping rows in Excel with similar values在 Excel 中对具有相似值的行进行分组
【发布时间】：2018-08-24 15:50:11
【问题描述】：

我有一个第一列包含一些数字的表格，我想循环遍历并根据第一列中的值对表格的行进行分组，以便它们可以折叠。与 shift+alt+right 的作用非常相似。作为一个例子，我想用这样的行转换一个表

放入这样的表格中，每个分组都可扩展且位于同一级别。

我一直在尝试更改从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

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

【问题讨论】：

我想你想创建一个“order by”而不是“group by”
@split 你说的排序是什么意思？它们已经按顺序排列了，我现在只需要将这些行组合在一起。
我的意思是“分组依据”是一种将所有（相似）行与一些新信息（每种类型的数量等）连接起来的方法。你想要做的是一些排序和折叠。
@split 哦，好的，谢谢，我会调查一下，看看它是否有效。
我过去遇到的一个问题是，如果您使用分组，则需要在要分组的项目之间留一个空白行。如果将 2 行和相邻的 2 行分组，它们将合并为一个大组。如果你还想走 Grouping 的路，我会推荐一个 backstepping 循环插入一行，然后如果 row 有值就进行分组。

标签： excel vba

【解决方案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

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

【讨论】：

【解决方案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

未经测试，但应该给出适当的例子。

【讨论】：