透视表页字段多级联动

jssy

透视表页字段多级联动

页字段多级联动.rar (10.56 KB, 下载次数: 800)

2010-4-18 23:41 上传

点击文件名下载附件

1. 
   
2. Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
   
3.    On Error Resume Next
   
4.    Dim i%, j%, n%, item$, rng As Range, pvi As PivotItem
   
5.    Application.ScreenUpdating = False
   
6.    Application.EnableEvents = False
   
7.    
   
8.    Set pvt = Sh.PivotTables(1)
   
9.    Set rng = ThisWorkbook.Sheets("数据源").UsedRange
   
10.    n = rng.Rows.Count
    
11.       
    
12.    For Each pvi In pvt.PivotFields("城市").PivotItems
    
13.      pvi.Visible = True
    
14.    Next
    
15.    
    
16.    For j = 2 To n
    
17.       If rng(j, 1) <> [b2] And [b2] <> "(全部)" Then
    
18.        item = rng(j, 2)
    
19.        pvt.PivotFields("城市").PivotItems(item).Visible = False
    
20.        End If
    
21.    Next
    
22.    
    
23.    Sh.PivotTables(1).PivotCache.Refresh
    
24.    Application.EnableEvents = True
    
25.    Application.ScreenUpdating = True
    
26. 
    
27. End Sub
    

复制代码

修改一下代码，提高运行效率

1. Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
   
2. 
   
3.    On Error Resume Next
   
4.    Dim i%, j%, n%, item0$, item1$, item2$, rng As Range, pvi As PivotItem
   
5.   Application.ScreenUpdating = False
   
6.    Application.EnableEvents = False
   
7.    Set pvt = Sh.PivotTables(1)
   
8.    Set rng = ThisWorkbook.Sheets("数据源").UsedRange
   
9.    n = rng.Rows.Count
   
10.    item0 = pvt.PivotFields("区域").CurrentPage
    
11.    For Each pvi In pvt.PivotFields("城市").PivotItems
    
12.        pvi.Visible = True
    
13.    Next
    
14.    For Each pvi In pvt.PivotFields("城市").PivotItems
    
15.        item2 = pvi
    
16.        For j = 2 To n
    
17.           If rng(j, 2) = item2 Then
    
18.             item1 = rng(j, 1)
    
19.             If item1 <> item0 And item0 <> "(All)" Then
    
20.                pvi.Visible = False
    
21.             End If
    
22.             Exit For
    
23.           End If
    
24.        Next
    
25.     Next
    
26.    Sh.PivotTables(1).PivotCache.Refresh
    
27.    Application.EnableEvents = True
    
28.    Application.ScreenUpdating = True
    
29.    
    
30. End Sub
    
31. 
    
32. 页字段多级联动.rar (262.09 KB, 下载次数: 2135)
    2010-4-20 14:37 上传

    点击文件名下载附件
    
    

复制代码

[ 本帖最后由 jssy 于 2010-4-20 14:37 编辑 ]

抹香鲸2009

传说中的沙发。楼主的VB出神入化了啊。真羡慕

[ 本帖最后由 抹香鲸2009 于 2010-4-1 16:57 编辑 ]

fengbin7506

谢谢分享，下载以后慢慢学习。

sukyliu1116

一想快要学了我就激动。。。一直想做这样的表。看起来也美观些。。

donghan

版主又有新作，收藏了

masterexcel

不错。很好，多谢楼主分享！

kumoo

厉害大人，拜学~~~~~~~~~~~~~~~~~

dgxsdr

下载学习！

Kimez12

又见vba，高级应用不能不学啊，不过这也是一直想要的功能。收藏。

pdamen

太有用了，代码也简单，留个记号，谢谢！