• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Meerdere slicers koppelen aan meerdere datasets

  • Onderwerp starter Onderwerp starter TWDR
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
T

TWDR

Gebruiker
Lid geworden
26 jun 2017
Berichten
53
Beste forummers,

Ik ben op dit moment bezig met het maken van een dashboardje. Hierin worden verschillende tabellen en draaitabellen gebruikt. Ik wil gebruik maken van slicers om de grafieken op het dashboard aan te passen op basis van deze selectie. Het is gelukt om één slicer te koppelen aan meerdere draaitabellen op basis van dezelfde dataset. Echter lukt het mij niet om één slicer te koppelen aan draaitabellen van verschillende datasets. Uiteraard komen de waarden op de slicer wel overeen. Als ik op internet zoek naar info dan kom ik steeds terecht bij slicersz koppelen aan dezelfde dataset..

Ik heb een testbestandje gemaakt met fictieve data en namen. Ik wil dus eigenlijk één slicer overhouden die dan beiden draaitabellen en grafieken bedient.
Wellicht dat dit met behulp van VBA te fixen is?

Tips en tricks worden zeer op prijs gesteld! :thumb:
 

Bijlagen

Nice thanks! :thumb:

Hier ga ik morgen even mee stoeien. Ik heb op zelfde website meteen ook gevonden hoe ik de selectiewaarde van een slicer in een cel of formule kan plaatsen. Top!
 
Nice! Goed bezig :D. Zeer duidelijk en overzichtelijke website met mooie artikelen. Ik ga ff rondsnuffelen.
 
De code om de slicers te synchroniseren werkt perfect! Dit is echt precies wat ik zocht :thumb:. Ik loop alleen toch nog tegen een probleempje aan..

Ik heb in totaal 6 slicers. 4 - datum en 2 - medewerkers waarbij elke categorie dezelfde waarden op de slicers hebben staan. Elke slicer verwijst naar een aparte draaitabel gemaakt vanuit twee datasets.

Beide codes werken perfect als ik ze - afzonderlijk - in 'ThisWorkbook' plaats. Alleen ik krijg het maar niet voor elkaar om beiden codes tegelijkertijd te laten werken. Hoe zorg ik ervoor beiden codes tegelijkertijd werken? :confused:
Tips worden zeer op prijs gesteld!!

Code: 
'Variable to prevent event looping
Dim mbNoEvent As Boolean

Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
'
'
Dim oScMedewerker As SlicerCache
Dim oScMedewerker1 As SlicerCache

Dim oSc As SlicerCache
Dim oPT As PivotTable
Dim oSi As SlicerItem

Dim bUpdate As Boolean

'Prevent event looping, changing a slicer in this routine also triggers this routine
If mbNoEvent Then Exit Sub
mbNoEvent = True

'Let it run in the background to speed things up
bUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
  
'step through all SlicerCaches and then through all their associated pivottables to find out which slicers are tied to the changed pivottable:
    For Each oSc In ThisWorkbook.SlicerCaches
        For Each oPT In oSc.PivotTables
            If oPT.Name = Target.Name And oPT.Parent.Name = Target.Parent.Name Then
                If oSc.Name Like "*Slicer_Medewerker*" Then
                    Set oScMedewerker = oSc
                ElseIf oSc.Name Like "*Slicer_Medewerker1*" Then
                    Set oScMedewerker1 = oSc
                End If
                Exit For
            End If
        Next
        If Not oScMedewerker Is Nothing And Not oScMedewerker1 Is Nothing Then Exit For
    Next

'Now that we have the slicer(s) that have been clicked, we want to sync them with slicers with similar names
'what the code below does is loop through all slicercaches again, looking at their names to figure out which ones belong together.

    If Not oScMedewerker Is Nothing Then
        For Each oSc In ThisWorkbook.SlicerCaches
            If Mid(oSc.Name, 7, 3) = Mid(oScMedewerker.Name, 7, 3) And oSc.Name <> oScMedewerker.Name Then
                'This one has a similar fieldname (first three characters are compared in this case)
                'but not the same name, as that would be the same slicercache.
                'So synch it with the changed year slicer
                'If a slicer has the very first item selected and you subsequently de-select it,
                'the end result is that all sliceritems get selected. So select the last item of the slicer first
                oSc.SlicerItems(oSc.SlicerItems.Count).Selected = True
                For Each oSi In oScMedewerker.SlicerItems
                    On Error Resume Next
                    If oSc.SlicerItems(oSi.Value).Selected <> oSi.Selected Then
                        oSc.SlicerItems(oSi.Value).Selected = oSi.Selected
                    End If
                Next
            End If
        Next
    End If

    If Not oScMedewerker1 Is Nothing Then
            For Each oSc In ThisWorkbook.SlicerCaches
                If Mid(oSc.Name, 7, 3) = Mid(oScMedewerker1.Name, 7, 3) And oSc.Name <> oScMedewerker1.Name Then
                    oSc.SlicerItems(oSc.SlicerItems.Count).Selected = True
                    For Each oSi In oScMedewerker1.SlicerItems
                        On Error Resume Next
                        If oSc.SlicerItems(oSi.Value).Selected <> oSi.Selected Then
                            oSc.SlicerItems(oSi.Value).Selected = oSi.Selected
                        End If
                    Next
                End If
            Next
    End If

    mbNoEvent = False
    Application.ScreenUpdating = bUpdate
    
End Sub

Private Sub Workbook_SheetPivotTableUpdate2(ByVal Sh As Object, ByVal Target As PivotTable)
'
'

Dim oScDatum As SlicerCache
Dim oScDatum1 As SlicerCache
Dim oScDatum2 As SlicerCache
Dim oScDatum3 As SlicerCache

Dim oSc As SlicerCache
Dim oPT As PivotTable
Dim oSi As SlicerItem

Dim bUpdate As Boolean

'Prevent event looping, changing a slicer in this routine also triggers this routine
If mbNoEvent Then Exit Sub
mbNoEvent = True

'Let it run in the background to speed things up
bUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
  
'step through all SlicerCaches and then through all their associated pivottables to find out which slicers are tied to the changed pivottable:
    For Each oSc In ThisWorkbook.SlicerCaches
        For Each oPT In oSc.PivotTables
            If oPT.Name = Target.Name And oPT.Parent.Name = Target.Parent.Name Then
                If oSc.Name Like "*Slicer_Datum*" Then
                    Set oScDatum = oSc
                ElseIf oSc.Name Like "*Slicer_Datum1*" Then
                    Set oScDatum1 = oSc
                ElseIf oSc.Name Like "*Slicer_Datum2*" Then
                    Set oScDatum2 = oSc
                ElseIf oSc.Name Like "*Slicer_Datum3*" Then
                    Set oScDatum3 = oSc
                End If
                Exit For
            End If
        Next
        If Not oScDatum Is Nothing And Not oScDatum1 Is Nothing And Not oScDatum2 Is Nothing And Not oScDatum3 Is Nothing Then Exit For
    Next

'Now that we have the slicer(s) that have been clicked, we want to sync them with slicers with similar names
'what the code below does is loop through all slicercaches again, looking at their names to figure out which ones belong together.

    If Not oScDatum Is Nothing Then
        For Each oSc In ThisWorkbook.SlicerCaches
            If Mid(oSc.Name, 7, 3) = Mid(oScDatum.Name, 7, 3) And oSc.Name <> oScDatum.Name Then
                'This one has a similar fieldname (first three characters are compared in this case)
                'but not the same name, as that would be the same slicercache.
                'So synch it with the changed year slicer
                'If a slicer has the very first item selected and you subsequently de-select it,
                'the end result is that all sliceritems get selected. So select the last item of the slicer first
                oSc.SlicerItems(oSc.SlicerItems.Count).Selected = True
                For Each oSi In oScDatum.SlicerItems
                    On Error Resume Next
                    If oSc.SlicerItems(oSi.Value).Selected <> oSi.Selected Then
                        oSc.SlicerItems(oSi.Value).Selected = oSi.Selected
                    End If
                Next
            End If
        Next
    End If

    If Not oScDatum1 Is Nothing Then
            For Each oSc In ThisWorkbook.SlicerCaches
                If Mid(oSc.Name, 7, 3) = Mid(oScDatum1.Name, 7, 3) And oSc.Name <> oScDatum1.Name Then
                    oSc.SlicerItems(oSc.SlicerItems.Count).Selected = True
                    For Each oSi In oScDatum1.SlicerItems
                        On Error Resume Next
                        If oSc.SlicerItems(oSi.Value).Selected <> oSi.Selected Then
                            oSc.SlicerItems(oSi.Value).Selected = oSi.Selected
                        End If
                    Next
                End If
            Next
    End If

    If Not oScDatum2 Is Nothing Then
            For Each oSc In ThisWorkbook.SlicerCaches
                If Mid(oSc.Name, 7, 3) = Mid(oScDatum2.Name, 7, 3) And oSc.Name <> oScDatum2.Name Then
                    oSc.SlicerItems(oSc.SlicerItems.Count).Selected = True
                    For Each oSi In oScDatum2.SlicerItems
                        On Error Resume Next
                        If oSc.SlicerItems(oSi.Value).Selected <> oSi.Selected Then
                            oSc.SlicerItems(oSi.Value).Selected = oSi.Selected
                        End If
                    Next
                End If
            Next
    End If
    
    If Not oScDatum3 Is Nothing Then
            For Each oSc In ThisWorkbook.SlicerCaches
                If Mid(oSc.Name, 7, 3) = Mid(oScDatum3.Name, 7, 3) And oSc.Name <> oScDatum3.Name Then
                    oSc.SlicerItems(oSc.SlicerItems.Count).Selected = True
                    For Each oSi In oScDatum3.SlicerItems
                        On Error Resume Next
                        If oSc.SlicerItems(oSi.Value).Selected <> oSi.Selected Then
                            oSc.SlicerItems(oSi.Value).Selected = oSi.Selected
                        End If
                    Next
                End If
            Next
    End If

    mbNoEvent = False
    Application.ScreenUpdating = bUpdate
    
End Sub
 
Als volgt...
Code: 
'Variable to prevent event looping
Dim mbNoEvent As Boolean

Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
'
'
    Dim oScMedewerker As SlicerCache
    Dim oScMedewerker1 As SlicerCache

    Dim oSc As SlicerCache
    Dim oPT As PivotTable
    Dim oSi As SlicerItem
    '
    '

    Dim oScDatum As SlicerCache
    Dim oScDatum1 As SlicerCache
    Dim oScDatum2 As SlicerCache
    Dim oScDatum3 As SlicerCache


    Dim bUpdate As Boolean

    'Prevent event looping, changing a slicer in this routine also triggers this routine
    If mbNoEvent Then Exit Sub
    mbNoEvent = True

    'Let it run in the background to speed things up
    bUpdate = Application.ScreenUpdating
    Application.ScreenUpdating = False

    'step through all SlicerCaches and then through all their associated pivottables to find out which slicers are tied to the changed pivottable:
    For Each oSc In ThisWorkbook.SlicerCaches
        For Each oPT In oSc.PivotTables
            If oPT.Name = Target.Name And oPT.Parent.Name = Target.Parent.Name Then
                If oSc.Name Like "*Slicer_Medewerker*" Then
                    Set oScMedewerker = oSc
                ElseIf oSc.Name Like "*Slicer_Medewerker1*" Then
                    Set oScMedewerker1 = oSc
                End If
                Exit For
            End If
        Next
        If Not oScMedewerker Is Nothing And Not oScMedewerker1 Is Nothing Then Exit For
    Next

    'Now that we have the slicer(s) that have been clicked, we want to sync them with slicers with similar names
    'what the code below does is loop through all slicercaches again, looking at their names to figure out which ones belong together.

    If Not oScMedewerker Is Nothing Then
        For Each oSc In ThisWorkbook.SlicerCaches
            If Mid(oSc.Name, 7, 3) = Mid(oScMedewerker.Name, 7, 3) And oSc.Name <> oScMedewerker.Name Then
                'This one has a similar fieldname (first three characters are compared in this case)
                'but not the same name, as that would be the same slicercache.
                'So synch it with the changed year slicer
                'If a slicer has the very first item selected and you subsequently de-select it,
                'the end result is that all sliceritems get selected. So select the last item of the slicer first
                oSc.SlicerItems(oSc.SlicerItems.Count).Selected = True
                For Each oSi In oScMedewerker.SlicerItems
                    On Error Resume Next
                    If oSc.SlicerItems(oSi.Value).Selected <> oSi.Selected Then
                        oSc.SlicerItems(oSi.Value).Selected = oSi.Selected
                    End If
                Next
            End If
        Next
    End If

    If Not oScMedewerker1 Is Nothing Then
        For Each oSc In ThisWorkbook.SlicerCaches
            If Mid(oSc.Name, 7, 3) = Mid(oScMedewerker1.Name, 7, 3) And oSc.Name <> oScMedewerker1.Name Then
                oSc.SlicerItems(oSc.SlicerItems.Count).Selected = True
                For Each oSi In oScMedewerker1.SlicerItems
                    On Error Resume Next
                    If oSc.SlicerItems(oSi.Value).Selected <> oSi.Selected Then
                        oSc.SlicerItems(oSi.Value).Selected = oSi.Selected
                    End If
                Next
            End If
        Next
    End If

    'step through all SlicerCaches and then through all their associated pivottables to find out which slicers are tied to the changed pivottable:
    For Each oSc In ThisWorkbook.SlicerCaches
        For Each oPT In oSc.PivotTables
            If oPT.Name = Target.Name And oPT.Parent.Name = Target.Parent.Name Then
                If oSc.Name Like "*Slicer_Datum*" Then
                    Set oScDatum = oSc
                ElseIf oSc.Name Like "*Slicer_Datum1*" Then
                    Set oScDatum1 = oSc
                ElseIf oSc.Name Like "*Slicer_Datum2*" Then
                    Set oScDatum2 = oSc
                ElseIf oSc.Name Like "*Slicer_Datum3*" Then
                    Set oScDatum3 = oSc
                End If
                Exit For
            End If
        Next
        If Not oScDatum Is Nothing And Not oScDatum1 Is Nothing And Not oScDatum2 Is Nothing And Not oScDatum3 Is Nothing Then Exit For
    Next

    'Now that we have the slicer(s) that have been clicked, we want to sync them with slicers with similar names
    'what the code below does is loop through all slicercaches again, looking at their names to figure out which ones belong together.

    If Not oScDatum Is Nothing Then
        For Each oSc In ThisWorkbook.SlicerCaches
            If Mid(oSc.Name, 7, 3) = Mid(oScDatum.Name, 7, 3) And oSc.Name <> oScDatum.Name Then
                'This one has a similar fieldname (first three characters are compared in this case)
                'but not the same name, as that would be the same slicercache.
                'So synch it with the changed year slicer
                'If a slicer has the very first item selected and you subsequently de-select it,
                'the end result is that all sliceritems get selected. So select the last item of the slicer first
                oSc.SlicerItems(oSc.SlicerItems.Count).Selected = True
                For Each oSi In oScDatum.SlicerItems
                    On Error Resume Next
                    If oSc.SlicerItems(oSi.Value).Selected <> oSi.Selected Then
                        oSc.SlicerItems(oSi.Value).Selected = oSi.Selected
                    End If
                Next
            End If
        Next
    End If

    If Not oScDatum1 Is Nothing Then
        For Each oSc In ThisWorkbook.SlicerCaches
            If Mid(oSc.Name, 7, 3) = Mid(oScDatum1.Name, 7, 3) And oSc.Name <> oScDatum1.Name Then
                oSc.SlicerItems(oSc.SlicerItems.Count).Selected = True
                For Each oSi In oScDatum1.SlicerItems
                    On Error Resume Next
                    If oSc.SlicerItems(oSi.Value).Selected <> oSi.Selected Then
                        oSc.SlicerItems(oSi.Value).Selected = oSi.Selected
                    End If
                Next
            End If
        Next
    End If

    If Not oScDatum2 Is Nothing Then
        For Each oSc In ThisWorkbook.SlicerCaches
            If Mid(oSc.Name, 7, 3) = Mid(oScDatum2.Name, 7, 3) And oSc.Name <> oScDatum2.Name Then
                oSc.SlicerItems(oSc.SlicerItems.Count).Selected = True
                For Each oSi In oScDatum2.SlicerItems
                    On Error Resume Next
                    If oSc.SlicerItems(oSi.Value).Selected <> oSi.Selected Then
                        oSc.SlicerItems(oSi.Value).Selected = oSi.Selected
                    End If
                Next
            End If
        Next
    End If

    If Not oScDatum3 Is Nothing Then
        For Each oSc In ThisWorkbook.SlicerCaches
            If Mid(oSc.Name, 7, 3) = Mid(oScDatum3.Name, 7, 3) And oSc.Name <> oScDatum3.Name Then
                oSc.SlicerItems(oSc.SlicerItems.Count).Selected = True
                For Each oSi In oScDatum3.SlicerItems
                    On Error Resume Next
                    If oSc.SlicerItems(oSi.Value).Selected <> oSi.Selected Then
                        oSc.SlicerItems(oSi.Value).Selected = oSi.Selected
                    End If
                Next
            End If
        Next
    End If

    mbNoEvent = False
    Application.ScreenUpdating = bUpdate

End Sub
Dit zou nog wat efficienter kunnen door wat van de loops in elkaar te schuiven maar daar was ik te lui voor :-)
 
Laatst bewerkt:
Je bent een held! :eek:

Hij is snel genoeg dus helemaal perfect :thumb:
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan