Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.06.2024 19:56:24
17.06.2024 19:39:46
Anzeige
Archiv - Navigation
1508to1512
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
Inhaltsverzeichnis

Spalten gleichzeit in PIV Wertebereich ziehen

Spalten gleichzeit in PIV Wertebereich ziehen
07.08.2016 20:28:49
lena list

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

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Ungetestet
07.08.2016 21:26:12
RPP63
Hi!
Application.DisplayAlerts = False
könnte helfen.
Braucht nicht zurückgesetzt werden, wenn es die einzig zu erwartende Meldung ist.
Gruß Ralf
AW: Ungetestet
08.08.2016 17:43:23
Lena List
Hallo Ralf,
Danke für deine rasche Rückmeldung. Bin VBA Anfängerin, wenn ich es in den Code einbaue, funktioniert es leider nicht. An welcher Stelle baust du den Baustein denn ein ins Makro? Muss ich zusätzluch was löschen?
Danke für deine Hilfe..
Lg und schönen Abend,
Lena
AW: Spalten gleichzeit in PIV Wertebereich ziehen
08.08.2016 18:44:23
Werner
Hallo Lena,
Sub SummePIV()
Dim pvTab As PivotTable, i%, Nr_Startfeld%, Nr_LetztesFeld%
Dim sMsgTitel 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
Nr_Startfeld = 5
Nr_LetztesFeld = 999
Set pvTab = ActiveSheet.PivotTables(1)
If Nr_Startfeld = 0 Then GoTo Fehler
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
Ich hab jetzt aber nur die Input-Boxen raus gemacht und den Variablen Nr_Startfeld den festen 5 und Nr_LetztesFeld den festen Wert 999 zugewiesen. Den Rest des Codes habe ich mir nicht angeschaut.
Gruß Werner
Anzeige
AW: Spalten gleichzeit in PIV Wertebereich ziehen
08.08.2016 19:23:43
lena list
Hallo Werner,
funktioniert perfekt. Super.
Vielen Dank für deine Hilfe. Ich bin begeistert.
Toll:-)
Lg und schönen Abend dir,
lena
AW: Gerne u. Danke für die Rückmeldung. o.w.T
08.08.2016 19:31:34
Werner

315 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige