[已解决]日期同步VBA

fangniuji

大家帮忙一下写一个VBa，在数据透视单元格（B1，B17，as6,aw6,ba 6,bw3,ck3,cw2,di2,dv2,es2,Ey2)下拉中随便找一个日期，如11-6，所有单元格日期都变一样，日期同步，谢谢

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-11-16 21:15

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim mydate As Date
   
3.     If Target(1).Value = "日期" Then
   
4.         mydate = Target(1, 2).Value
   
5.     Else
   
6.         Exit Sub
   
7.     End If
   
8. 
   
9.     Dim pt As PivotTable
   
10.     Dim pf As PivotField
    
11. 
    
12.     On Error Resume Next
    
13.     Application.EnableEvents = False
    
14.     Application.ScreenUpdating = False
    
15.     For Each pt In ActiveSheet.PivotTables
    
16.         pt.ManualUpdate = True
    
17.         Debug.Print pt.Name, pt.PivotFields("日期").CurrentPage
    
18.         pt.PivotFields("日期").CurrentPage = mydate
    
19.         pt.ManualUpdate = False
    
20.     Next
    
21.     Application.ScreenUpdating = True
    
22.     Application.EnableEvents = True
    
23. End Sub

复制代码

放入统计工作表表内。
数透表多，刷新是有时间的。
工作簿需保存为XLSM格式，不然代码会丢的。

跳转到最佳答案楼层

hwc2ycy

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim mydate As Date
   
3.     If Target(1).Value = "日期" Then
   
4.         mydate = Target(1, 2).Value
   
5.     Else
   
6.         Exit Sub
   
7.     End If
   
8. 
   
9.     Dim pt As PivotTable
   
10.     Dim pf As PivotField
    
11. 
    
12.     On Error Resume Next
    
13.     Application.EnableEvents = False
    
14.     Application.ScreenUpdating = False
    
15.     For Each pt In ActiveSheet.PivotTables
    
16.         pt.ManualUpdate = True
    
17.         Debug.Print pt.Name, pt.PivotFields("日期").CurrentPage
    
18.         pt.PivotFields("日期").CurrentPage = mydate
    
19.         pt.ManualUpdate = False
    
20.     Next
    
21.     Application.ScreenUpdating = True
    
22.     Application.EnableEvents = True
    
23. End Sub

复制代码

放入统计工作表表内。
数透表多，刷新是有时间的。
工作簿需保存为XLSM格式，不然代码会丢的。

fangniuji

hwc2ycy 发表于 2013-11-16 21:15
放入统计工作表表内。
数透表多，刷新是有时间的。
工作簿需保存为XLSM格式，不然代码会丢的。

好像不运行，再帮我看看，谢谢！！！

hwc2ycy

位置没放对吧，我这已经测试了没问题。

hwc2ycy

统计 工作表 内。

hwc2ycy

YM2.rar (1.11 MB, 下载次数: 1)

2013-11-16 21:23 上传

点击文件名下载附件

fangniuji

hwc2ycy 发表于 2013-11-16 21:23

在我这边就不运行，如附件，谢谢。

hwc2ycy

啥版本啊，启用宏了没？
关闭EXCEL再打开呢。

fangniuji

hwc2ycy 发表于 2013-11-16 22:42
啥版本啊，启用宏了没？
关闭EXCEL再打开呢。

2007

hwc2ycy