Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1156to1160
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
mehrere Spalten auf einmal in Pivot ziehen
Maria
Hallo zusammen,
eine Frage zur schnellen Erstellung von Pivots:
Die Datenquelle enthält eine Zeitreihe über mehrere Jahre hinweg (ca. 50 Spalten für die einzelnen Monate). Die einzelnen Elemente der Datenquelle möchte ich in der Pivot in den Datenbereich ziehen. Muss ich nun wirklich 50 mal aus der Feldliste die Elemente einzeln in den Datenbereich ziehen? Kann ich sie nicht irgendwie gesammelt markieren und rüberziehen?
Und im Datenbereich erscheinen die Werte zunächst als Anzahl. Weiß jemand, wie sich das gesammelt auf Summe umstellen lässt? (Wieder das gleiche Problem wie oben: Ich will nicht 50 Elemente einzeln anklicken und auf Summe ändern).
Bin gespannt auf eure Antworten.
Viele Grüße
Maria

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: mehrere Spalten auf einmal in Pivot ziehen
15.05.2010 11:50:21
fcs
Hallo Maria,
manuell kommst du um die um die Sysiphus-Arbeit nicht herum.
Es gibt keine Option, mit der man die Berechnungsfunktion vorgeben kann. Sobald in der Spalte eines Pivotfeldes eine leere Zelle oder Text vorhanden ist verwendet Excel automatisch die Anzahl-Funktion.
Nachfolgend 2 Makros, mit denen du dir das Anlegen vieler Summen-Felder im Datenbereich erleichtern kannst.
Gruß
Franz
'Erstellt unter Excel 2007 - Kompatibilitäts-Modus
Sub Pivot_Daten_Summenfelder_A()
Dim pvTab As PivotTable, pvField As PivotField, I As Long
Dim rngSpaltentitel As Range, Zelle As Range, A
Dim sMsgTitel As String, iFehler%
'Funktioniert nur, wenn Datenquelle der Pivottabelle eine Excel-Tabelle ist
'Makro starten wenn Tabelle mit der angelegten PivotTabelle aktiv.
'Pivottabelle sollte noch keine Felder im Datenbereich enthalten
sMsgTitel = "Pivottabelle - Datenbereichfelder anlegen"
On Error GoTo Fehler
iFehler = 1
Set pvTab = ActiveSheet.PivotTables(1)
iFehler = 2
Set rngSpaltentitel = Application.InputBox( _
Prompt:="Bitte in Datenquelle den Bereich mit den Spaltentiteln markieren, " _
& "die als Summenfelder im Datenbereich eingefügt werden sollen.", _
Title:=sMsgTitel, Type:=8)
'1. Spalte der Datenquelle ermitteln
iFehler = 3
With pvTab
A = .SourceData
A = Mid(A, InStr(1, A, "!") + 2)
If InStr(1, A, "C") > 0 Then
'R1C1-Schreibweise
A = Mid(A, InStr(1, A, "C") + 1)
ElseIf InStr(1, A, "S") > 0 Then
'Z1S1-Schreibweise
A = Mid(A, InStr(1, A, "S") + 1)
Else
MsgBox "Bitte Schreibweise von SourceData prüfen und Code anpassen" _
& vbLf & "SourceData: " & .SourceData
GoTo Fehler
End If
A = Val(Left(A, InStr(1, A, ":") - 1))
A = A - 1
End With
'Datenbereichsfelder anlegen
iFehler = 4
With rngSpaltentitel
For I = .Column - A To .Column + .Columns.Count - 1 - A
With pvTab
.AddDataField Field:=.PivotFields(I), _
Caption:="Summe " & .PivotFields(I).Name, Function:=xlSum
End With
Next
End With
Err.Clear
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case 13 'Type-Fehler - Bereichsauswahl wurde abgebrochen
If iFehler  2 Then
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbInformation + vbOKOnly, sMsgTitel
End If
Case 1004
Select Case iFehler
Case 1
MsgBox "Fehler-Nr.: " & .Number & vbLf & _
"Aktive Tabelle enthält keine Pivot-Tabelle", _
vbInformation + vbOKOnly, sMsgTitel
Case 4
MsgBox "Fehler-Nr.: " & .Number & vbLf _
& "Feldname ""Summe " & pvTab.PivotFields(I).Name & """ existiert schon.", _
vbInformation + vbOKOnly, sMsgTitel
Resume Next
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbInformation + vbOKOnly, sMsgTitel
End Select
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbInformation + vbOKOnly, sMsgTitel
End Select
End With
End Sub
'Erstellt unter Excel 2007 - Kompatibilitäts-Modus
Sub Pivot_Daten_Summenfelder_B()
Dim pvTab As PivotTable, I%, Nr_Startfeld%, Nr_LetztesFeld%
Dim sMsgTitel As String, sMsgText As String, iFehler%
sMsgTitel = "Pivottabelle - Datenbereichfelder anlegen"
'Makro starten wenn Tabelle mit der angelegten PivotTabelle aktiv.
'Pivottabelle sollte noch keine Pivotfelder im Datenbereich enthalten
On Error GoTo Fehler
iFehler = 1
Set pvTab = ActiveSheet.PivotTables(1)
sMsgText = "Pivot-Feldes angeben, das als Summenfeld im " _
& "Datenbereich eingefügt werden soll."
Nr_Startfeld = Application.InputBox( _
Prompt:="Bitte lfnd. Nr des 1. " & sMsgText, _
Title:=sMsgTitel, Default:=5, Type:=1)
If Nr_Startfeld = 0 Then GoTo Fehler
Nr_LetztesFeld = Application.InputBox( _
Prompt:="Bitte lfnd. Nr des letzten" & sMsgText _
& vbLf & "999 = bis zum letzten Pivot-Feld", _
Title:=sMsgTitel, Default:=999, Type:=1)
If Nr_LetztesFeld = 0 Then GoTo Fehler
With pvTab
If Nr_LetztesFeld > .PivotFields.Count Or Nr_LetztesFeld = 999 Then
Nr_LetztesFeld = .PivotFields.Count
End If
iFehler = 4
'Datenbereichsfelder anlegen
For I = Nr_Startfeld To Nr_LetztesFeld
.AddDataField Field:=.PivotFields(I), _
Caption:="Summe " & .PivotFields(I).Name, Function:=xlSum
Next
End With
Err.Clear
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case 1004
Select Case iFehler
Case 1
MsgBox "Fehler-Nr.: " & .Number & vbLf & _
"Aktive Tabelle enthält keine Pivot-Tabelle", _
vbInformation + vbOKOnly, sMsgTitel
Case 4
MsgBox "Fehler-Nr.: " & .Number & vbLf _
& "Feldname ""Summe " & pvTab.PivotFields(I).Name & """ existiert schon.", _
vbInformation + vbOKOnly, sMsgTitel
Resume Next
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbInformation + vbOKOnly, sMsgTitel
End Select
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbInformation + vbOKOnly, sMsgTitel
End Select
End With
Set pvTab = Nothing
End Sub

Anzeige

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige