两个透视表相互叠加 - VBA到aut。隐藏两者之间的线条

时间:2018-03-08 10:17:34

标签: excel-vba vba excel

在工作表中,我有两个彼此叠加的数据透视表。我需要一个可以隐藏两个数据透视表之间的行的VBA宏。挑战是速度......使用循环非常慢。有没有办法解决这个问题?到目前为止,我已经创建了一个宏,用于标识第一个pivot,table和第二个pivotable的第一行的最后一行。

With ActiveSheet.PivotTables(2)
    LastRow2 = .TableRange2.Row
    With .TableRange2
        LastRow2 = .Rows.Count + .Row - 1
    End With
End With

With ActiveSheet.PivotTables(1)
    TopRow1 = .TableRange1.Row
    With .TableRange1
        TopRow1 = .Row
    End With
End With

'Here I need some VBA to hide all rows in between LastRow2 and TopRow1

2 个答案:

答案 0 :(得分:0)

单程

Range("A" & LastRow2 + 1 & ":A" & TopRow1 - 1).EntireRow.Hidden = True

答案 1 :(得分:0)

确定哪个表位于顶部,然后使用.TableRange2获取表格范围,并Offset按单元格向上/向下移动。然后在一个操作中显示/隐藏所有这些行:

Dim ptTop As PivotTable, ptBottom As PivotTable

'Check which table is "Top" or "Bottom"
If ActiveSheet.PivotTables(1).TableRange2.Cells(1, 1).Row < ActiveSheet.PivotTables(2).TableRange2.Cells(1, 1).Row Then
    Set ptTop = ActiveSheet.PivotTables(1)
    Set ptBottom = ActiveSheet.PivotTables(2)
Else
    Set ptTop = ActiveSheet.PivotTables(2)
    Set ptBottom = ActiveSheet.PivotTables(1)
End If

'Unhide from top of Top table to bottom of Bottom table
ActiveSheet.Range(ptBottom.TableRange2.Cells(ptBottom.TableRange2.Rows.Count, 1), _
    ptTop.TableRange2.Cells(1, 1)).EntireRow.Hidden = False

'If there is at least 1 row between the tables
If ptTop.TableRange2.Cells(ptTop.TableRange2.Rows.Count, 1).Offset(1, 0) < ptBottom.TableRange2.Cells(1, 1).Row Then
    'Hide from below bottom of Top table to above top of Bottom Table
    ActiveSheet.Range(ptTop.TableRange2.Cells(ptTop.TableRange2.Rows.Count, 1).Offset(1, 0), _
        ptBottom.TableRange2.Cells(1, 1).Offset(-1, 0)).EntireRow.Hidden = True
End If

Set ptTop = Nothing
Set ptBottom = Nothing