Draaitabel aanpassen met macro

[mauricebosman]

Hallo helpmij forummers,

ik heb een probleem om een macro te maken dat een draaitabel wijzigt (zie bestand). In dit geval kunnen teams hun eigen team (bijv team 1) kiezen uit de lijst in cel C2. Dan kunnen ze op de pijltjes (bijv. naam) klikken om alle namen van team 1 te zien in de draaitabel.

Ik probeer het voor elkaar te krijgen dat wanneer op 1 van de pijltjes geklikt wordt, een macro van start gaat dat de draaitabel aanpast, zodanig dat alleen het gekozen team (uit cel C2) zichtbaar wordt met alleen de gegevens van de gekozen eigenschap van het team (bijv naam). Ik zou dus in dit geval 3 macros willen maken die de draaitabel aanpassen zodat alleen het gekozen team te zien is met gegevens van 'hun' eigenschap.

Ik heb een aantal Excel VBA programmeer boeken bekeken, maar heb nog niet kunnen vinden hoe ik
- een cel als input kan krijgen voor de functie PivotItems (Bijv. PivotItems(C2).Visible = True)
- op een efficiente manier de macros dynamisch kan krijgen. Ik loop nu tegen beperkingen op van VBA (hidden loopt vast als het object al weg is) en Excel (wisselen van team 1 naar team 2 lukt niet efficient doordat er minstens één rij zichtbaar moet zijn)

Zouden jullie mij willen helpen om de macros te maken?

Alvast bedankt!

Maurice Bosman

 

[PSVSupporter]

Hier een stukje code uit een Excel bestand wat ik dagelijks gebruik.
In een bepaalde cel komt altijd het maximum te staan van de beschikbare datums.

Deze wordt uitgelezen en op basis hiervan worden weken aangezet, danwel uitgezet. Op deze manier krijg ik altijd de 20 meest recente weken te zien in mijn draaitabel (en in de grafiek die ik er aan gekoppeld heb).

Waar je specifiek op moet letten is dat een PivotField altijd minimaal 1 waarde moet hebben. Vandaar dat ik in mijn macro ervoor gekozen heb alle velden uit te vinken, behalve de meest recente. Die zet ik dan ook als eerste op True.

Helpt dit je op weg?

Sub Select_20wk(blad As String)
    Dim Weken As Variant
    Dim MaxDatum As Date
    Dim MinDatum As Date
    Dim PerDatum As Date
    Weken = Array(False, False, False, False, False, False, False, False, False, False _
                , False, False, False, False, False, False, False, False, False, False _
                , False, False, False, False, False, False, False, False, False, False _
                , False, False, False, False, False, False, False, False, False, False _
                , False, False, False, False, False, False, False, False, False, False _
                , False, False, False, False)
    Sheets(blad).Select
    ActiveSheet.PivotTables("Draaitabel1").PivotCache.Refresh
    MaxDatum = ActiveSheet.Range("IB6").Value
    MinDatum = MaxDatum - 139
    Week = PWeek(MaxDatum)
    MaxJaar = Year(MaxDatum)
   
    y = ActiveSheet.PivotTables("Draaitabel5").PivotFields("Jaar").PivotItems.Count
    With ActiveSheet.PivotTables("Draaitabel5").PivotFields("Jaar")
    For x = 1 To y
        If .PivotItems(y - x + 1).Name = Format(MinDatum, "yyyy") Or .PivotItems(y - x + 1).Name = Format(MaxDatum, "yyyy") Then
            .PivotItems(y - x + 1).Visible = True
        Else
            .PivotItems(y - x + 1).Visible = False
        End If
    Next x
    End With
    
    For PerDatum = MinDatum To MaxDatum
        Weken(PWeek(PerDatum)) = True
    Next PerDatum
    
    For x = 1 To ActiveSheet.PivotTables("Draaitabel5").PivotFields("Week").PivotItems.Count
        With ActiveSheet.PivotTables("Draaitabel5").PivotFields("Week")
            If .PivotItems(x).Name > Maxwaarde Then
                Maxwaarde = .PivotItems(x).Name + 0
            End If
        End With
    Next x

    For x = Maxwaarde To Maxwaarde
        Waarde = Format(x, "#0")
        With ActiveSheet.PivotTables("Draaitabel5").PivotFields("Week")
            .PivotItems (Waarde)
            .PivotItems(Waarde).Visible = True
        End With
    Next x
    For x = 1 To Maxwaarde
        Waarde = Format(x, "#0")
        With ActiveSheet.PivotTables("Draaitabel5").PivotFields("Week")
            .PivotItems(Waarde).Visible = Weken(x)
        End With
    Next x
End Sub

 

[PSVSupporter]

Jouw bestand bekeken. Ik heb deze code nu gebruikt voor Macro1. Is dit wat je bedoeld?

Sub Macro1()
'
' Naam Macro
'

    ' Om foutmeldingen te voorkomen: Eerst checken of de "Orientation" een andere waarde heeft.
    ' Als deze al 'visible' of 'hidden' is, kun je een foutmelding krijgen.
    If ActiveSheet.PivotTables("Draaitabel1").PivotFields("Naam").Orientation <> xlColumnField Then
        ActiveSheet.PivotTables("Draaitabel1").PivotFields("Naam").Orientation = xlColumnField
    End If
    If ActiveSheet.PivotTables("Draaitabel1").PivotFields("Adres").Orientation <> xlHidden Then
        ActiveSheet.PivotTables("Draaitabel1").PivotFields("Adres").Orientation = xlHidden
    End If
    If ActiveSheet.PivotTables("Draaitabel1").PivotFields("Telefoon").Orientation <> xlHidden Then
        ActiveSheet.PivotTables("Draaitabel1").PivotFields("Telefoon").Orientation = xlHidden
    End If
    GekozenNaam = Sheets("Sheet1").Range("C5").Value
    
    ' Maak eerst alles even 'true', hiermee voorkom je dat je per ongeluk alles op False zet. Als
    ' alles op False komt te staan, krijg je een foutmelding.
    AantalVelden = ActiveSheet.PivotTables("Draaitabel1").PivotFields.Count
    For x = 1 To AantalVelden
        With ActiveSheet.PivotTables("Draaitabel1").PivotFields(x)
            AantalItems = ActiveSheet.PivotTables("Draaitabel1").PivotFields(x).PivotItems.Count
            For y = 1 To AantalItems
                ActiveSheet.PivotTables("Draaitabel1").PivotFields(x).PivotItems(y).Visible = True
            Next y
        End With
    Next x
    
    AantalNamen = ActiveSheet.PivotTables("Draaitabel1").PivotFields("Naam").PivotItems.Count
    
    Gevonden = False
    With ActiveSheet.PivotTables("Draaitabel1").PivotFields("Naam")
        For x = 1 To AantalNamen
            If .PivotItems(x).Name = GekozenNaam Then
                Gevonden = True
            End If
        Next x
    End With

    If Gevonden = True Then
    With ActiveSheet.PivotTables("Draaitabel1").PivotFields("Naam")
        For x = 1 To AantalNamen
            If .PivotItems(x).Name = GekozenNaam Then
                .PivotItems(x).Visible = True
            Else
                    .PivotItems(x).Visible = False
            End If
        Next x
    End With
        Sheets("Sheet1").Range("H5").Value = ""
    Else
        Sheets("Sheet1").Range("H5").Value = "Naam Niet gevonden"
    End If

End Sub

 

[mauricebosman]

PSVSupporter, bedankt voor je antwoord. Jammer genoeg ben ik (nog) niet zo bekend met VBA, heb wel een beetje algemene programmeerkennis.

Ik begrijp mijn eigen code nog niet echt, laat staan dat ik uit jouw code kan halen hoe ik mijn eigen code kan verbeteren...

In jouw code, in welke cel staat de input? Ik vermoed dat het hier in staat:

PivotItems(y - x + 1).Name = Format(MinDatum, "yyyy")

maar ik begrijp de code niet. Hoe werkt het?

Nu ik jouw code zie, ben ik me ook gaan afvragen of het efficienter/sneller is om een bestaande tabel aan te passen of om een nieuwe te maken. Weet iemand dit? Het gaat om 25 teams met in totaal 20,000 personen x 30 eigenschappen.

Heeft iemand een simpeler voorbeeld die ik kan gebruiken om de macros te maken?

Maurice

 

[mauricebosman]

Jouw bestand bekeken. Ik heb deze code nu gebruikt voor Macro1. Is dit wat je bedoeld?

Bedank voor je moeitet! Ik check hem even...

 

[mauricebosman]

PSVSupporter, heel erg bedankt voor de code! Hij doet het bijna! Hij doet het goed, alleen doet hij het verkeerde goed.

Je ging ervanuit dat ik in cel C5 (staat nu "naam") een naam (bijv Henk) neerzet. De naam macro hoeft de naam Henk niet te zoeken en weer te geven, maar alle namen van het team in C2 weer te geven. Als ik dus de "naam macro" start, met in cel C2 "Team 2", dan moet de draaitabel alle namen weergeven van Team 2.

Zou je dit alsjeblieft in de code willen aanpassen? Alvast heel erg bedankt!

Maurice

 

[PSVSupporter]

Ja, dat bedoel ik.

Ik denk overigens dat een filter veel effectiever werkt. Je kunt dan evengoed nog wel kolommen verbergen enzo.

Check deze eens:

 

[mauricebosman]

PSVSupporter, dit is inderdaad veel makkelijker dan een draaitabel!

Ik heb het bestand aangepast, zodat de vorm is zoals ik hem zou willen hebben. In cel H2 is de teamnaam aan te geven. Daarnaast zijn er zoekknoppen. Als je dus op de zoekknop naast "naam" drukt, start de "naam macro" en deze laat de kolom "naam" verschijnen naast de kolom personeelsnummer en kolom team (welke geordend is op aangegeven teamnaam). De andere kolommen worden verborgen.

Kun je me wat tips geven om dit in een macro te zetten?

Daarnaast komen er in de toekomst nog mensen bij, waardoor de tabel langer wordt. ActiveSheetRange moet dus dynamisch worden. Heb je hier ook een tip voor?

Fijn dat je me helpt!

 

[mauricebosman]

Hoi, het is me gelukt om te filteren. Nu heb ik alleen nog een probleem om het bereik dynamisch te krijgen.

Mijn code:

Sub Klikken1()
    Dim myrange As Range
    
    Range("A9").Select
    
    Selection.CurrentRegion.Select
    MsgBox Selection.Address
    myrange = Selection.Address
    MsgBox myrange
        
    ActiveSheet.Range(myrange).AutoFilter
    'Hide all columns greater than C
    Range("D:E").Select
    Selection.EntireColumn.Hidden = True

End Sub

Hij geeft een fout 91 melding bij myrange = Selection.Address. Weet iemand wat voor variabele myrange moet zijn? Het is blijkbaar geen Range. Alvast bedankt!

 

[jarik]

Ik ben momenteel bezig met het maken van een rapportage in excel. ik heb een pivot table en ik heb diverse formules. Nu wil ik graag dat als ik op een cell sta die in de pivot filter voorkomt dat de pivot table filter deze cel selecteerd. Dus ik heb bijvoorbeeld in mijn pivot table filter de waarden:
brood
vlees
vis

en ik heb in mijn werkmap een cel met de naam brood dan wil ik als de cel brood is geselecteerd de pivot table automatisch de selectie brood laat zien.

Bij voorbaat dank! Ik heb nog niet veel kennis met macro's maar weet inmiddels deels hoe het in elkaar zit.

 

[huijb]

Oude topics mogen met rust gelaten worden. Deze gaat op slot.