Slicer aanpassen n.a.v. celwaarden

Status
Niet open voor verdere reacties.
M

marcovanderh

Gebruiker
Lid geworden
22 okt 2012
Berichten
25
Goedendag,

Ik heb in Excel een slicer van een draaigrafiek.
Nu zou ik graag willen dat die de weken selecteert op basis van de waarden uit de cellen B2 t/m B53 van het werkblad Hulpblad.
In de cellen A2 t/m A53 staan weeknummers. In B2 t/m B53 geeft die "Ja" of "Nee" aan in de cel.
Wanneer de cel een Ja geeft moet het weeknummer in de slicer actief staan. Geeft die Nee aan dan moet deze in de slicer inactief staan.

Makkelijkst leek me om dit via een Macro te doen maar geen idee hoe.

Dit heb ik tot nu toe:

Code: 
Sub Selecteer12weken()
    With ActiveWorkbook.SlicerCaches("Slicer_Week")
    Dim cijfer As Integer, resultaat As String
        .SlicerItems("1").Selected = False
        .SlicerItems("2").Selected = False
        .SlicerItems("3").Selected = False
        .SlicerItems("4").Selected = False
        .SlicerItems("5").Selected = False
        .SlicerItems("6").Selected = False
        .SlicerItems("7").Selected = False
        .SlicerItems("8").Selected = False
        .SlicerItems("9").Selected = False
        .SlicerItems("10").Selected = False
        .SlicerItems("11").Selected = False
        .SlicerItems("12").Selected = False
        .SlicerItems("13").Selected = False
        .SlicerItems("14").Selected = False
        .SlicerItems("15").Selected = False
        .SlicerItems("16").Selected = False
        .SlicerItems("17").Selected = False
        .SlicerItems("18").Selected = False
        .SlicerItems("19").Selected = False
        .SlicerItems("20").Selected = True
        .SlicerItems("21").Selected = True
        .SlicerItems("22").Selected = True
        .SlicerItems("23").Selected = True
        .SlicerItems("24").Selected = True
        .SlicerItems("25").Selected = True
        .SlicerItems("26").Selected = True
        .SlicerItems("27").Selected = True
        .SlicerItems("28").Selected = True
        .SlicerItems("29").Selected = True
        .SlicerItems("30").Selected = True
        .SlicerItems("31").Selected = True
        .SlicerItems("32").Selected = False
        .SlicerItems("33").Selected = False
        .SlicerItems("34").Selected = False
        .SlicerItems("35").Selected = False
        .SlicerItems("36").Selected = False
        .SlicerItems("37").Selected = False
        .SlicerItems("38").Selected = False
        .SlicerItems("39").Selected = False
        .SlicerItems("40").Selected = False
        .SlicerItems("41").Selected = False
        .SlicerItems("42").Selected = False
        .SlicerItems("43").Selected = False
        .SlicerItems("44").Selected = False
        .SlicerItems("45").Selected = False
        .SlicerItems("46").Selected = False
        .SlicerItems("47").Selected = False
        .SlicerItems("48").Selected = False
        .SlicerItems("49").Selected = False
        .SlicerItems("50").Selected = False
        .SlicerItems("51").Selected = False
        .SlicerItems("52").Selected = False
    End With

End Sub

Hoe krijg ik voor elkaar dat hij bij de weeknummers waarbij Ja komt dat de Macro die op True zet en als de waarde op Nee staat dat de Macro de sliceritem op False zet?

Alvast hartelijk dank voor de hulp.
Groet, Marco
 
Excuus,

Bij deze een voorbeeldbestandje...
 

Bijlagen

  • Voorbeeldbestandje.xlsm
    890,1 KB · Weergaven: 18
Zoiets?
Code: 
Sub Selecteer12weken()
Dim sv, j As Long
Application.ScreenUpdating = 0
sv = Sheets("hulpblad").Range("b2:b53")
    With ThisWorkbook.SlicerCaches("Slicer_Week")
        .ClearAllFilters
      For j = 1 To .SlicerItems.Count
       .SlicerItems(j).Selected = sv(j, 1) <> "Nee"
      Next j
    End With
End Sub
 
Code: 
Sub M_snb()
  sn = Blad4.Range("B2:B53")
    
  With ActiveWorkbook.SlicerCaches("Slicer_Week")
    For Each it In .SlicerItems
      it.Selected = IsNumeric(sn(it.SourceName, 1))
    Next
  End With
End Sub

Zet alle daggegevens in 1 werkblad met een extra kolom voor de datum, zodat je maar 1 werkblad met gegevens overhoudt.
Dan kun je alle databasefaciliteiten van Excel gebruiken.
 
Laatst bewerkt:
it.caption kan ook nog.

Zonder .clearAllfilters gaan bij mij de vorige gezette filters niet weg.
Getest door cel B1 te veranderen in bv. het cijfer 4 en weer terug naar 39.
 
In mijn versie (E2010) ontbreekt een methode clearallfilters.

Want dan zou je kunnen volstaan met:

Code: 
Sub M_snb()
  sn = Blad4.Range("B2:B53").specialcells(-4123,1)
    
  With ActiveWorkbook.SlicerCaches("Slicer_Week")
    .clearallfilters
    For Each it In sn
      .sliceritems(cstr(it)).Selected = true
    Next
  End With
End Sub
 
't Is wat die verschillende versies.

Ik ben niet zo van de specialcells, maar dat is ook een methode.
Mijn code doorlopend met F8 zonder .clearAllFilters gaan de filters in eerste instantie op false tot filter 15 of zoiets.
Aangekomen op 16 gaan alle filters ineens op true.

Misschien gebeurt dit in jouw versie dan weer niet.
 
Het hele hulpwerkblad is overbodig.
De formules daarin wel erg knullig.

Zo gaat het hier zoals gewenst:

Code: 
Sub M_snb()
  y = Blad1.Cells(1, 4) - 11
    
  With ActiveWorkbook.SlicerCaches("Slicer_Week")
    For Each it In .SlicerItems
      it.Selected = (Val(it.Caption) >= y) * (Val(it.Caption) <= y + 11)
    Next
  End With
End Sub
Zo hebben we de clearfilters niet nodig.
 
Laatst bewerkt:
Wederom weer mooi, maar werkelijk geen idee waarom het hapert in mijn versie bij het terugzetten van de filters die al stonden.
 
Bij mij werkt de clearmanualfilter ook anders dan verwacht.
 
snb zei:
Code: 
Sub M_snb()
  sn = Blad4.Range("B2:B53")
    
  With ActiveWorkbook.SlicerCaches("Slicer_Week")
    For Each it In .SlicerItems
      it.Selected = IsNumeric(sn(it.SourceName, 1))
    Next
  End With
End Sub

Zet alle daggegevens in 1 werkblad met een extra kolom voor de datum, zodat je maar 1 werkblad met gegevens overhoudt.
Dan kun je alle databasefaciliteiten van Excel gebruiken.
Klik om te vergroten...

Dit werkt voor mij.
Dank voor jullie hulp en input.
En dat de formules en wijze waarop niet heel netjes zijn is zeker waar. Ben niet zo gevorderd als jullie helaas :D

Dank en een fijne avond allemaal!
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan