Hallo zusammen,
ich habe eine Frage zu einem VBA Makro, mit dem ich mehrere Spalten gleichzeitig in den Wertebereich einer PIVOT Tabelle ziehen kann.
Ich möchte die Spalten (5 bis 999) nicht manuell aus der Feldliste in den Wertebreich der Pivot Tabelle ziehen (das dauert Ewigkeiten:-)..), sondern diese per VBA gesammelt markieren und verschieben.
Ich habe aus dem Jahr 2010 das folgende Makro gefunden und an meine Splaten-Nummern angepasst:
Nun wollte ich fragen, ob in diesem Makro ich auch die Textbox, die erscheint und nach der ersten und letzten Splate fragt weglassen kann, weil die erste Spalte immer die 5. Spalte ist und die letzte immer die 999. So dass ich nicht in die Textbox dies eingeben muss, sondern standarddgemäß dies immer übernommen wird ohne Eingabe. Anbei das Makro, das ich verwendet habe:
Sub SummePIV()
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
Vielen Dank für eure Hilfe und ich wünsche einen schönen Abend.
lena