VBA Dynamischer Datenbereich in Pivot-Tabelle

Question

Ich habe ein Makro, das in einer leeren Arbeitsmappe vorhanden ist. Jeden Tag Daten werden eingefügt und das Makro wird dann ausgeführt. Ein Teil des Makros ist, dass es die Datenquelle in einer Pivot-Tabelle aktualisiert und aktualisiert. Wenn ich die Daten einfügen und das Makro ausführen, wird die Fehlermeldung einer leeren Spaltenüberschrift ausgegeben. Das dynamische Element scheint nicht korrekt zu funktionieren.

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

Ich habe .SpecialCells(xlLastCell) noch nie benutzt, also bin ich nicht sicher, wie zuverlässig es ist. Es ist möglich, dass beim Einfügen neuer Daten alte Spalten berücksichtigt werden, da einige Formatierungen vorhanden sind. Dies kann passieren, wenn Sie beim Löschen Ihrer alten Daten einfach den Löschschlüssel verwenden, anstatt die Zellen physisch zu löschen. Hier ist, wie würde ich den neuen Bereich schlage vor zu gehen über das Erhalten:

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 

HINWEIS: diese Antwort geht davon aus, dass Ihre Daten immer Anfang in A1 eingefügt wird, und dass es für jede Zeile ein Wert in Spalte A wird in Ihr Datensatz.