После обновления источника данных сводной таблицы Excel с VBA, ОШИБКА: отчет сводной таблицы был сохранен без соответствующих данных - PullRequest
Новая
       74

После обновления источника данных сводной таблицы Excel с VBA, ОШИБКА: отчет сводной таблицы был сохранен без соответствующих данных

0 голосов
/ 27 марта 2020

Я работал над макросом, который копирует серию сводных таблиц на нескольких вкладках вместе с вкладкой источника данных в новую рабочую книгу. При копировании сводных таблиц в новую рабочую книгу они зависали в источнике данных из исходной рабочей книги.

Чтобы устранить эту проблему, я добавил следующий код в свой макрос. 

Dim pt As PivotTable
Dim ws as Worksheet

For Each ws In ActiveWorkbook.Worksheets
For Each pt In ws.PivotTables
         pt.ChangePivotCache ActiveWorkbook.PivotCaches.Create _
           (SourceType:=xlDatabase, SourceData:=Worksheets("Raw").Range("A3:AP125000"))
Next pt
Next ws

ActiveWorkbook.RefreshAll

Это, похоже, решило проблему, и все работало нормально, пока я не добавил дополнительный код для сохранения каждого из полученных файлов. Файлы сохранились нормально, но после того, как вы открыли и попытались отфильтровать или изменить сводную таблицу, вы получили следующее сообщение: «Отчет сводной таблицы был сохранен без базовых данных. Используйте команду Refre sh Data для обновления отчета». Если вы обновите sh отдельную сводную таблицу или нажмете ссылку sh Все в Excel, проблема устранена, и все хорошо ... Пока ... Вы можете сохранить файл снова, но в следующий раз, когда откроете его, возникает та же проблема .. Я не хочу создавать это бремя для пользователей, которые будут открывать эти файлы ...

Интересно, почему ActiveWorkbook.RefreshAll в моем макросе не работает / залипает, и открытие и нажмите кнопку Refre sh All in Excel, чтобы решить проблему только для одного сеанса? Любые предложения о том, как это исправить?

Вот мой код целиком: 

Sub CreateFiles()


With Application
.Calculation = xlAutomatic
.ScreenUpdating = False
.DisplayAlerts = False
End With


'Paste Values on Raw data tab
Sheets("Raw").Select
Range("A3:M125000").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

'Create a new workbook for each facility in column A on the Macro tab, also stamp the facility ID on 
the Raw data tab
Worksheets("Macro").Activate
Dim bottomA As Integer
bottomA = Range("A" & Rows.Count).End(xlUp).Row
Dim c As Range
Dim ws As Worksheet
For Each c In Range("A2:A" & bottomA)
    Set ws = Nothing
    On Error Resume Next
    Set ws = Worksheets(c.Value)
    On Error GoTo 0
    If ws Is Nothing Then
        Sheets("Raw").Select
        With ActiveSheet
        .Range("B2").Value = c.Value
    End With
    End If


'Copy only the tabs you need
Sheets(Array("Referral - Origin", "Admission - Origin", "Denial - Origin", _
    "Referral - Physician", "Admission - Physician", "Denial - Physician", _
    "Referral - Referral Source", "Admission - Referral Source", _
    "Denial - Referral Source", "Raw")).Copy




'Now we can paste values on the Raw data tab for the remaing cells we were waiting on, dependent on 
the facility ID stamp
Sheets("Raw").Select
Range("A1:AP3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Sheets("Raw").Select
Range("N4:N125000").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False



'Delete extra rows on the Raw data tab to minimize file space
Worksheets("Raw").Activate
Range("N4:N125000").Replace "False", "#N/A", xlWhole
On Error Resume Next
Range("N4:N125000").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
On Error GoTo 0


'Hide raw tab
Sheets("Raw").Visible = False


'Fix PivotTable DataSource so that it points to newly created workbook rather than the original 
workbook
Dim pt As PivotTable


For Each ws In ActiveWorkbook.Worksheets
For Each pt In ws.PivotTables
         pt.ChangePivotCache ActiveWorkbook.PivotCaches.Create _
            (SourceType:=xlDatabase, SourceData:=Worksheets("Raw").Range("A3:AP125000"))
Next pt
Next ws


'Go to first tab and pivots refresh

Sheets("Referral - Origin").Select
Range("A1").Select

ActiveWorkbook.RefreshAll

'Save workbook

ChDir "C:\Temp"
ActiveWorkbook.SaveAs Filename:="C:\Temp\" & Worksheets("Raw").Range("B2") & "_" & 
Worksheets("Raw").Range("C2") & ".xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False

'Close newly created workbook

 ActiveWorkbook.Close



'Repeat

Next c


 With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With

End Sub
...