VBA Динамический диапазон данных в сводной таблице

У меня есть макрос, который существует в пустой книге. Каждый день данные будут вставлены, и макрос будет запущен. Одна часть макроса заключается в том, что он обновляет источник данных в сводной таблице и обновляется. Когда я вставляю данные и запускаю макрос, он выдает сообщение об ошибке заголовка пустого столбца. Динамический элемент работает некорректно.

Function PivotTable() Dim Data_sht As Worksheet Dim Pivot_sht As Worksheet Dim StartPoint As range Dim DataRange As range Dim PivotName As String Dim NewRange As String 'Set Variables Equal to Data Sheet and Pivot Sheet Set Data_sht = ThisWorkbook.Worksheets("Sheet1") Set Pivot_sht = ThisWorkbook.Worksheets("Pivot Table") 'Enter in Pivot Table Name PivotName = "PivotTable" 'Dynamically Retrieve Range Address of Data Set StartPoint = Data_sht.range("A1") Set DataRange = Data_sht.range(StartPoint, StartPoint.SpecialCells(xlLastCell)) NewRange = Data_sht.Name & "!" & _ DataRange.Address(ReferenceStyle:=xlR1C1) 'Make sure every column in data set has a heading and is not blank (error prevention) If WorksheetFunction.CountBlank(DataRange.Rows(1)) > 0 Then MsgBox "One of your data columns has a blank heading." & vbNewLine _ & "Please fix and re-run!.", vbCritical, "Column Heading Missing!" End If 'Change Pivot Table Data Source Range Address Pivot_sht.PivotTables(PivotName).ChangePivotCache _ ThisWorkbook.PivotCaches.Create( _ SourceType:=xlDatabase, _ SourceData:=NewRange) 'Ensure Pivot Table is Refreshed Pivot_sht.PivotTables(PivotName).RefreshTable End Function 

Я никогда раньше не использовал .SpecialCells(xlLastCell) , поэтому я не уверен, насколько он надежный. Возможно, что когда вы вставляете новые данные, они все еще рассматривают старые столбцы, потому что есть некоторое форматирование. Это может произойти, если при удалении старых данных вы просто используете ключ удаления, а не физически удаляете ячейки. Вот как я хотел бы предложить получить новый диапазон:

 Sub PivotTable() Dim Data_sht As Worksheet Dim Pivot_sht As Worksheet Dim lrow_data As Long Dim lcol_data As Long Dim DataRange As Range Dim PivotName As String 'Set Variables Equal to Data Sheet and Pivot Sheet Set Data_sht = ThisWorkbook.Worksheets("Sheet1") Set Pivot_sht = ThisWorkbook.Worksheets("Pivot Table") 'Enter in Pivot Table Name PivotName = "PivotTable" 'Dynamically Retrieve Range Address of Data With Data_sht lrow_data = .Cells(Cells.Rows.Count, 1).End(xlUp).Row 'gets last row lcol_data = .Cells(1, Cells.Columns.Count).End(xlToLeft).Column 'gets last column Set DataRange = .Range(.Cells(1, 1), .Cells(lrow_data, lcol_data)) End With 'Make sure every column in data set has a heading and is not blank (error prevention) If WorksheetFunction.CountBlank(DataRange.Rows(1)) > 0 Then MsgBox "One of your data columns has a blank heading." & vbNewLine _ & "Please fix and re-run!.", vbCritical, "Column Heading Missing!" End End If 'Change Pivot Table Data Source Range Address Pivot_sht.PivotTables(PivotName).ChangePivotCache _ ThisWorkbook.PivotCaches.Create( _ SourceType:=xlDatabase, _ SourceData:=DataRange) 'Ensure Pivot Table is Refreshed Pivot_sht.PivotTables(PivotName).RefreshTable End Sub 

ПРИМЕЧАНИЕ. В этом ответе предполагается, что ваши данные всегда вставлены начиная с A1, и что в каждой строке вашего набора данных будет значение в столбце A.

Давайте будем гением компьютера.