VBA在Pivot表中的動態數據範圍

Question

我有一個存在於空工作簿中的宏。 每天都會粘貼數據，然後宏將運行。 宏的一部分是它更新數據透視表中的數據源並刷新。當我粘貼數據並運行宏時，它會拋出空白列標題的錯誤消息。動態元素似乎沒有正常工作。

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 

Answer 1

我以前從未使用過.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列中的值你的數據集。