AW: Datenschnitt die zweite!
26.06.2016 14:27:31
Michael
Hi Michael,
ich benutze kaum Pivot und so Zeug, aber wenn man die Änderung mit dem Makrorekorder aufzeichnet, kommt so etwas dabei heraus:
Sub Makro1()
' Makro1 Makro
'Unter Modul1 ************************
With ActiveWorkbook.SlicerCaches("Datenschnitt_Datum")
.SlicerItems("Mai").Selected = True
.SlicerItems("Jan").Selected = False
.SlicerItems("Feb").Selected = False
.SlicerItems("Mrz").Selected = False
.SlicerItems("Apr").Selected = False
.SlicerItems("Jun").Selected = False
.SlicerItems("Jul").Selected = False
.SlicerItems("Aug").Selected = False
.SlicerItems("Sep").Selected = False
.SlicerItems("Okt").Selected = False
.SlicerItems("Nov").Selected = False
.SlicerItems("Dez").Selected = False
.SlicerItems("<01.04.2016").Selected = False
.SlicerItems(">02.07.2016").Selected = False
End With
End Sub
was man dann in eine Schleife stecken kann:
Sub sliceAendern()
Dim d, ds$, slI As SlicerItem
Dim gefunden As Boolean, alterSl$
d = Range("I3")
If IsDate(Range("I3")) Then ds = Format(d, "MMM") Else MsgBox "ungültiges Datum": Exit Sub
For Each slI In ActiveWorkbook.SlicerCaches("Datenschnitt_Datum").SlicerItems
If slI.Selected Then alterSl = slI.Name
If slI.Name = ds Then slI.Selected = True: gefunden = True Else slI.Selected = False
Next
If Not gefunden Then
ActiveWorkbook.SlicerCaches("Datenschnitt_Datum").SlicerItems(alterSl).Selected = True
MsgBox "nicht geändert"
Else
MsgBox "geändert auf " & ds
End If
End Sub
Das Ganze läßt sich dann noch anpassen:
Option Explicit
'Unter Tabelle1 ************************
Private Sub Worksheet_Activate()
Dim d, ds$, slI As SlicerItem, anz&
Dim gefunden As Boolean, alterSl$
d = Range("I3")
If IsDate(Range("I3")) Then ds = Format(d, "MMM") Else MsgBox "ungültiges Datum": Exit Sub
For Each slI In ActiveWorkbook.SlicerCaches("Datenschnitt_Datum").SlicerItems
Debug.Print "vor: slI " & slI.Name & " sel " & slI.Selected & " aSl " & alterSl
If slI.Name = ds Then
gefunden = True
If slI.Selected Then MsgBox "Bereits selektiert": Exit For
slI.Selected = True
Else
If slI.Selected Then
anz = anz + 1
If anz > 1 Then
slI.Selected = False
Else
alterSl = slI.Name
End If
End If
End If
Debug.Print "nach: slI " & slI.Name & " sel " & slI.Selected & " aSl " & alterSl
Next
If gefunden And alterSl <> "" Then
ActiveWorkbook.SlicerCaches("Datenschnitt_Datum").SlicerItems(alterSl).Selected = False
MsgBox "nicht geändert"
Else
MsgBox "geändert auf " & ds
End If
End Sub
Wie gesagt, ich arbeite fast nie mit dem Zeug... Wenn man etwas in die Tiefe geht, wird's wie so oft kompliziert: der obere Algo bügelt alles raus, was nicht dem Datum in I3 entspricht, der untere soll eigentlich etwas feiner arbeiten, hakelt aber, insbesondere, wenn zuvor mehrere Begriffe selektiert waren.
Ich denke, Du kannst mit dem Grundgerüst arbeiten, die Verfeinerung überlasse ich mal Dir.
Die beiden Zeilen mit dem debug.print schreiben die Zwischenergebnisse ins "Direktfenster", das ist wie Textverarbeitung: vor dem erneuten Aufruf mit Strg-a und Entf am besten löschen...
Ansonsten siehe: http://www.online-excel.de/excel/singsel_vba.php?f=105
Die Datei: https://www.herber.de/bbs/user/106540.xlsm
Schöne Grüße,
Michael