SourceData bei Pivot Uptaden / Probleme
26.04.2006 11:04:42
Martin
Hallo Excel VBA-Experten
Meine Unwissenheit beschämt mich, aber ich gebe es zu, "da komme ich nicht weiter"!
Diese beiden Scripts lesen alle Pivot Tabellen-Eckdaten in ein Tabellenblatt, in welchem
die Details überarbeitet werden können und mitd dem zweiten werden (sollten eigentlich)
die Daten im Pivot geupdatet. Diese Vorgehensweise ist bei Querytables erfolgreich und bei Pivot
noch nicht.
Sub PivotSourceDataAuslesen()
Dim pvt As PivotTable
Dim wsh As Worksheet
Dim Tab_vorhanden As Boolean
Dim pvt_Anzahl As Integer
pvt_Anzahl = 0
Tab_vorhanden = True
For Each wsh In ActiveWorkbook.Worksheets
If wsh.Name = "PivotSource" Then
Tab_vorhanden = False
Exit For
End If
Next
If Tab_vorhanden Then
ActiveWorkbook.Sheets.Add Before:=ActiveWorkbook.Worksheets(1)
ActiveSheet.Name = "PivotSource"
End If
Sheets("PivotSource").Cells(1, 1).Value = "Tabelle"
Sheets("PivotSource").Cells(1, 2).Value = "Pivot"
Sheets("PivotSource").Cells(1, 3).Value = "SourceData"
For Each wsh In ActiveWorkbook.Worksheets
For Each pvt In wsh.PivotTables
pvt_Anzahl = pvt_Anzahl + 1
Sheets("PivotSource").Cells(1 + pvt_Anzahl, 1) = wsh.Name
Sheets("PivotSource").Cells(1 + pvt_Anzahl, 2) = pvt.Name
Sheets("PivotSource").Cells(1 + pvt_Anzahl, 3) = pvt.SourceData
Next
Next
If pvt_Anzahl = 0 Then
MsgBox "Keine Queries in dieser Arbeitsmappe", vbExclamation
Else
MsgBox "Total " & pvt_Anzahl & " Queries in der Arbeitsmappe.", vbInformation
End If
End Sub
Sub PivotSourceDataEinlesen()
Dim pvt As QueryTable
Dim wsh As Worksheet
Dim Tab_vorhanden As Boolean
Dim pvt_Anzahl As Integer
Tab_vorhanden = False
For Each wsh In ActiveWorkbook.Worksheets
If wsh.Name = "PivotSource" Then
Tab_vorhanden = True
Exit For
End If
Next
If Not (Tab_vorhanden) Then
MsgBox "Keine PivotSourcedata vorhanden!" & vbCrLf & _
"Update nicht erfolgt!", vbCritical
Exit Sub
End If
For Each wsh In ActiveWorkbook.Worksheets
For Each pvt In wsh.QueryTables
pvt_Anzahl = 1
Do While Sheets("PivotSource").Cells(1 + pvt_Anzahl, 1).Value <> ""
If wsh.Name = Sheets("PivotSource").Cells(1 + pvt_Anzahl, 1).Value And _
pvt.Name = Sheets("PivotSource").Cells(1 + pvt_Anzahl, 2) Then
pvt.Connection = Sheets("PivotSource").Cells(1 + pvt_Anzahl, 3).Value
MsgBox "Blatt:" & wsh.Name & vbCrLf & _
"Pivot:" & pvt.Name & " angepasst!", vbInformation
End If
pvt_Anzahl = pvt_Anzahl + 1
Loop
Next
Next
End Sub
Danke für Eure Hilfe