问题描述:
在资源管理器里复制Excel文件,如A文件:商品报表.xlsx复制为B文件:商品报表 - 副本.xlsx,其中A文件中有很多透视表。这时B文件中的透视表的数据源居然变成了'[商品报表.xlsx]Sheet1'!$A$1:$Q$1501,自动添加了A文档的绝对路径!透视表的数据源并不指向B文件本身!当文件中有大量透视表的时候,一个个的修改透视表的数据源简直要崩溃。。。从2013年就有人向微软反应了这个问题,但至今没有解决。试验下来只有两个办法:
1. 在建立透视表的时候,勾选将此数据添加到数据模型
2. 用VBA自动更新所有透视表的数据源
Public Sub Update_PivotTables_Source()
Dim currWS As Worksheet
Dim currPT As PivotTable
Dim strName As String
Dim strMsg As String
Dim Res
On Error Resume Next
Filename = ThisWorkbook.Sheets("修改数据源").Cells(3, 3)
Workbooks.Open (Filename)
For Each currWS In Application.Worksheets
For Each currPT In currWS.PivotTables
currPT.SourceData = CutFilename(currPT.SourceData)
currPT.RefreshTable
Next currPT
Next currWS
MsgBox "所有透视表数据源更新完毕!"
End Sub
Private Function CutFilename(strSource As String) As String
Dim intPosition As Integer
Dim intStrLen As Integer
Dim blnFound As Boolean
Dim intFileStart As Integer
Dim intFileEnd As Integer
Dim chrCurr As String
strSource = Trim(strSource)
CutFilename = strSource
intPosition = 0: intStrLen = Len(strSource)
intFileStart = 0: intFileEnd = 0
blnFound = False
Do While (Not (blnFound) And (intPosition < intStrLen))
intPosition = intPosition + 1
chrCurr = Mid(strSource, intPosition, 1)
Select Case chrCurr
Case "["
intFileStart = intPosition
Case "]"
intFileEnd = intPosition
blnFound = True
End Select
Loop
If blnFound Then CutFilename = Mid(strSource, 1, intFileStart - 1) & Mid(strSource, intFileEnd + 1, intStrLen)
End Function