Power Query表格触发Range类Ungroup方法失败（运行时错误1004）

问题原因 #

Power Query生成的结构化表格（ListObject）与普通静态单元格区域的分组逻辑存在本质差异：结构化表格的行/列受表格自身结构约束，不支持直接对整个工作表的Rows/Columns对象执行Ungroup操作。原代码中ws.Rows.Ungroup和ws.Columns.Ungroup直接操作整个工作表的行/列，在Power Query表格场景下会触发结构冲突，导致运行时错误1004。

修改方案 #

核心思路是先识别Power Query生成的结构化表格，针对表格的DataBodyRange（数据区域）处理分组逻辑，同时保留对静态表格的兼容性。

完整修改代码 #

Sub update_default_row_column_groupings180()
    Dim ws As Worksheet
    Dim tbl As ListObject ' 定义Power Query表格对象
    
    Set ws = ThisWorkbook.Worksheets("180 Day")
    
    On Error GoTo err_exit
    Application.ScreenUpdating = False
    
    ' 定位工作表中的Power Query表格（假设仅存在一个）
    On Error Resume Next
    Set tbl = ws.ListObjects(1)
    On Error GoTo err_exit
    
    ' 分场景取消分组：Power Query表格/静态表格
    If Not tbl Is Nothing Then
        ' 取消表格数据区域的行/列分组
        For i = 1 To 8
            tbl.DataBodyRange.Rows.Ungroup
            tbl.DataBodyRange.Columns.Ungroup
        Next i
        ' 清理表格外的可能分组
        ws.Rows(1 & ":" & tbl.HeaderRowRange.Row - 1).Ungroup
        ws.Rows(tbl.DataBodyRange.Row + tbl.DataBodyRange.Rows.Count & ":" & ws.Rows.Count).Ungroup
        ws.Columns(1 & ":" & tbl.DataBodyRange.Column - 1).Ungroup
        ws.Columns(tbl.DataBodyRange.Column + tbl.DataBodyRange.Columns.Count & ":" & ws.Columns.Count).Ungroup
    Else
        ' 兼容静态表格的原有取消分组逻辑
        For i = 1 To 8
            ws.Rows.Ungroup
            ws.Columns.Ungroup
        Next i
    End If
    
    ' 取消所有行/列隐藏
    ws.Rows.Hidden = False
    ws.Columns.Hidden = False
    
    ' 列分组：分场景处理
    If Not tbl Is Nothing Then
        tbl.DataBodyRange.Columns("E:F").Group
        tbl.DataBodyRange.Columns("I:J").Group
        tbl.DataBodyRange.Columns("M").Group
        tbl.DataBodyRange.Columns("Q:R").Group
    Else
        ws.Cells.Columns("E:F").Group
        ws.Cells.Columns("I:J").Group
        ws.Cells.Columns("M").Group
        ws.Cells.Columns("Q:R").Group
    End If
    
    ' 行分组：传入表格对象兼容两种场景
    group_rows_hierarchy_level ws, hierarchy_level:="region", group_column:=2, start_row:=6, tbl:=tbl
    group_rows_hierarchy_level ws, hierarchy_level:="division", group_column:=2, start_row:=5, tbl:=tbl
    
err_exit:
    Application.ScreenUpdating = True ' 修复原代码错误：恢复屏幕更新
End Sub

Sub group_rows_hierarchy_level(ByVal ws As Worksheet, hierarchy_level As String, group_column As Long, start_row As Long, Optional tbl As ListObject = Nothing)
    Dim last_row As Long, group_start_row As Long, group_end_row As Long
    Dim i As Long, previous_val As String, current_val As String
    
    ' 获取正确的最后一行：Power Query表格/静态表格
    If Not tbl Is Nothing Then
        last_row = tbl.ListRows.Count + tbl.HeaderRowRange.Row
    Else
        last_row = ws.Cells(ws.Rows.Count, group_column).End(xlUp).Row
    End If
    
    group_start_row = 0
    group_end_row = 0
    
    For i = start_row To last_row
        previous_val = ws.Cells(i - 1, group_column).Value
        current_val = ws.Cells(i, group_column).Value
        
        If LCase(current_val) = LCase(hierarchy_level) Then
            If group_start_row = 0 Then
                group_start_row = i + 1
            ElseIf group_end_row = 0 Then
                group_end_row = IIf(LCase(previous_val) = "division" And LCase(hierarchy_level) = "region", i - 2, i - 1)
                ' 分场景执行行分组
                If Not tbl Is Nothing Then
                    tbl.DataBodyRange.Rows(group_start_row - tbl.HeaderRowRange.Row & ":" & group_end_row - tbl.HeaderRowRange.Row).Group
                Else
                    ws.Rows(group_start_row & ":" & group_end_row).Group
                End If
                group_start_row = i + 1
                group_end_row = 0
            End If
        End If
    Next i
    
    ' 处理最后一组行
    If group_start_row > 0 And group_start_row <= last_row Then
        If Not tbl Is Nothing Then
            tbl.DataBodyRange.Rows(group_start_row - tbl.HeaderRowRange.Row & ":" & last_row - tbl.HeaderRowRange.Row).Group
        Else
            ws.Rows(group_start_row & ":" & last_row).Group
        End If
    End If
    
    On Error Resume Next
    With ws.Outline
         .SummaryRow = xlAbove ' 修复原代码语法错误：补充点号
    End With
    On Error GoTo 0
End Sub

Sub group_columns(ws As Worksheet, col_groups As Variant, Optional tbl As ListObject = Nothing)
    For Each col_group In col_groups
        If Not tbl Is Nothing Then
            tbl.DataBodyRange.Columns(col_group).Group
        Else
            ws.Cells.Columns(col_group).Group
        End If
    Next col_group
End Sub

Sub group_rows(ws As Worksheet, row_groups As Variant, Optional tbl As ListObject = Nothing)
    For Each row_group In row_groups
        If Not tbl Is Nothing Then
            tbl.DataBodyRange.Rows(row_group).Group
        Else
            ws.Cells.Rows(row_group).Group
        End If
    Next row_group
End Sub

关键修改点说明 #

1. 新增结构化表格识别：通过ListObject定位Power Query生成的表格，针对表格数据区域执行分组操作，避免直接操作整个工作表的行/列。
2. 分场景逻辑兼容：同时支持Power Query表格和静态表格两种环境，确保代码在不同场景下都能正常运行。
3. 修复原代码错误：将错误退出时的Application.ScreenUpdating = False改为True，避免屏幕更新一直处于关闭状态；修正SummaryRow前的语法错误。
4. 精细化分组范围：针对表格内外区域分别处理取消分组，避免遗漏或冲突。

内容的提问来源于stack exchange，提问作者Sam R.