Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
776to780
776to780
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Pivot-Tabelle aus mehreren Dateien
29.06.2006 17:08:22
Anton
Hallo Leute,
ich habe ca. 30 Dateien, die als Quelle für eine Pivot-Tabelle dienen sollen.
Alle als Datenquelle benötigten Dateien habe ich im selben Ordner stehen.
Die Spaltenüberschriften (Zeile 1) sind in allen Dateien gleich.
Alle Datensätze zusammen würden das Fassungsvermögen eines Sheets weit übersteigen.
Ich möchte alle 30 Dateien zu einer Auswertung machen.
Hier mal der Code für nur eine Datei:

Sub PivotT_online_weekly()
' Makro1 Makro
' Makro am 28.06.2006 von Admin aufgezeichnet
' und händisch geändert
Dim zei As Long
Dateiname = ActiveWorkbook.Name 'Dateiname Deklarieren
'Alle Daten in eine neue Datei
Cells.Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
'Pivot-Tabelle der Datenquelle
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"Tabelle1!AA:AE").CreatePivotTable TableDestination:="", TableName:= _
"PivotTable1"
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable1").SmallGrid = False
ActiveSheet.PivotTables("PivotTable1").AddFields RowFields:=Array("AGENT", _
"Daten")
With ActiveSheet.PivotTables("PivotTable1").PivotFields("ZIELPERSON_ERREICHT")
.Orientation = xlDataField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("VERKAUF")
.Orientation = xlDataField
.Position = 2
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("ERREICHT_NEGATIV")
.Orientation = xlDataField
.Position = 3
End With
ActiveSheet.PivotTables("PivotTable1").PivotFields("GRUND_NICHT_ERREICHT"). _
Orientation = xlDataField
Range("B3").Select
ActiveSheet.PivotTables("PivotTable1").PivotSelect "", xlDataAndLabel
ActiveSheet.PivotTables("PivotTable1").Format xlReport4
Range("A1").Select
'Pivot-Tabelle entschärfen
Cells.Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
'Formatieren
Range("B3").Select
'Text umbrechen, damit es schmaler wird
ActiveCell.FormulaR1C1 = "Anzahl" & Chr(10) & "ZIELPERSON" & Chr(10) & "ERREICHT"
With ActiveCell.Characters(Start:=1, Length:=26).Font
.Name = "MS Sans Serif"
.FontStyle = "Fett"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
End With
Range("C3").Select
'Text umbrechen, damit es schmaler wird
ActiveCell.FormulaR1C1 = "Anzahl" & Chr(10) & "VERKAUF"
With ActiveCell.Characters(Start:=1, Length:=14).Font
.Name = "MS Sans Serif"
.FontStyle = "Fett"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
End With
Range("D3").Select
'Text umbrechen, damit es schmaler wird
ActiveCell.FormulaR1C1 = "Anzahl " & Chr(10) & "ERREICHT" & Chr(10) & "NEGATIV"
With ActiveCell.Characters(Start:=1, Length:=24).Font
.Name = "MS Sans Serif"
.FontStyle = "Fett"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
End With
Range("E3").Select
'Text umbrechen, damit es schmaler wird
ActiveCell.FormulaR1C1 = "Anzahl" & Chr(10) & "NICHT" & Chr(10) & "ERREICHT"
With ActiveCell.Characters(Start:=1, Length:=21).Font
.Name = "MS Sans Serif"
.FontStyle = "Fett"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
End With
'Einsetzen einer Spalte für Prozentsatz "VERKAUF"
Range("D3").Select
Selection.EntireColumn.Insert
ActiveCell.FormulaR1C1 = "Anteil" & Chr(10) & "VERKAUF"
'Einsetzen einer Spalte für Prozentsatz "ERREICHT - NEGATIV"
Range("F3").Select
Selection.EntireColumn.Insert
ActiveCell.FormulaR1C1 = "Anteil" & Chr(10) & "ERREICHT" & Chr(10) & "NEGATIV"
For zei = 4 To Range("A65536").End(xlUp).Row
'Einsetzen der Formel für Prozentsatz "VERKAUF"
Cells(zei, 4).FormulaR1C1 = "=RC[-1]*100/RC[-2]"
Cells(zei, 4).NumberFormat = "0.00"" %"""
'Einsetzen der Formel für Prozentsatz "ERREICHT - NEGATIV"
Cells(zei, 6).FormulaR1C1 = "=RC[-1]*100/RC[-4]"
Cells(zei, 6).NumberFormat = "0.00"" %"""
Next zei
'Zeilen in denen in Spalte A "(Leer)" ist, werden gelöscht
ende = Cells(Rows.Count, 1).End(xlUp).Row 'die 1 steht für die Spalte A
For i = ende To 2 Step -1
If Cells(i, 1) = "(Leer)" Then
Rows(i).Delete
End If
Next i
Range("A1").Select
'Spaltenbreite anpassen
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Range("C1").Select
'Datum holen
ActiveCell.Value = Dateiname
'in weisser Schrift
With ActiveCell.Characters.Font
.Name = "MS Sans Serif"
.FontStyle = "Fett"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
End With
Range("B1").Select
ActiveCell.FormulaR1C1 = "=(MID(RC[1],12,5))&"" - ""&(MID(RC[1],7,4))"
Range("A1").Select
ActiveCell.FormulaR1C1 = "Auswertung vom"
Range("A1:B1").Select
Selection.Font.Bold = True
Range("A2").Select
'Datei vereinfachen
Application.DisplayAlerts = False
'Überflüssige Tabellen löschen
Sheets(Array("Tabelle1", "Tabelle2", "Tabelle3")).Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
'Verbliebene Tabelle umbenennen
Sheets("Tabelle4").Select
Sheets("Tabelle4").Name = Range("B1").Value
Application.CutCopyMode = False
Range("A1").Select
End Sub

Ich habe keine Ahnung wie ich das auf alle Dateien nacheinander anwenden kann,
und im Anschluß eine Kummulierte Tabelle entstehen soll....
(Anmerkung: Wie Ihr im ersten Drittel meines Code sehen könnt, habe ich die Pivot tot gemacht. Ich brauche die Auswahlmöglichkeit nicht. Also braucht auch die kummulierte Tabelle keine "Funktion" mehr.)
Wer von Euch kann mir bei dieser kniffeligen Frage weiterhelfen?
Mein Dank geht schon jetzt in Eure Richtung.
Servus,
Anton

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Pivot-Tabelle aus mehreren Dateien
29.06.2006 17:35:21
Otto
Hallo Anton,
Meine Testumgebung: Excel 10.0 Deutsch unter Windows XP
sieh Dir doch bitte mal im Archiv Pivot-Tabellem über mehrere Blätter (581336#582754) an. Da hat Rolf Beißner die Frage direkt beantwortet.
Mir ist nicht klar, warum Du das Problem mit VBA angehen willst. Auf jeden Fall sind in Deinem Code sämtliche Selects überflüssig.
Deine Anmerkung habe ich nicht verstanden. Brauchst Du Pivot oder brauchst Du es nicht?
Gruß Otto
AW: Pivot-Tabelle aus mehreren Dateien
29.06.2006 18:14:25
Anton
Hallo Otto,
aus den Worten von Rolf Beißner bin ich leider nicht schlau geworden.
Ich hätte da noch die Idee die Inhalte der verschiedenen Dateien als verschiedene Tabellen in die selbe Datei zu stecken.
Was meine "Select"s angeht, die kommen vom aufzeichnen.
Dieses Jumbomakro ist ja schließlich Stück für Stück entstanden.
Klar, wenn ich den Recorder anwerfe, dass Excel Sachen reinschreibt die überflüssig sind.
Wie gesagt es sind ca. 30 Dateien.
Ich möchte einen Vorgang bauen, den mit nur einem Mausklick alles erledigt.
Vielleicht kannst Du mir Deinen Artikel näher erläutern.
Dank in Deine Richtung,
Servus,
Anton
Anzeige

318 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige