VBAdynamic数据范围在数据透视表中

我有一个空的工作簿中存在的macros。 每天数据将被粘贴，然后macros将被运行。 macros的一部分是更新数据透视表中的数据源并刷新。 当我粘贴数据并运行macros时，会抛出空白列标题的错误消息。 dynamic元素似乎不能正常工作。

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)之前，所以我不知道它是多么可靠。 当您粘贴新数据时，可能会考虑旧列，因为存在一些格式。 如果删除旧数据，可能会发生这种情况，您只需使用删除键而不是物理删除单元格。 以下是我如何build议去获得新的范围：

 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列都会有一个值。