Avatar billede overgreat Forsker
30. januar 2018 - 22:29 Der er 7 kommentarer og
1 løsning

Skrive i celle, hvad der i pivot-tabel er valgt i rapportfiltrene

Hej

Jeg har pivot hvor jeg bruger rapportfilter.

Brugerne kan vælge mange elementer...

I celle A1 (udenfor pivottabellen), vil jeg gerne liste alle de værdier, brugerne har valgt i rapportfilteret.

Hvordan gør jeg dette?
31. januar 2018 - 11:56 #1
Det kræver lidt VBA

Sub ListPivotFilter()
    Dim PvtTbl As PivotTable
    Dim pvtItm As PivotItem
    Set PvtTbl = Worksheets("Pivot").PivotTables("PivotSalg")
    Dim ValgtListe As String
    For Each pvtItm In PvtTbl.PivotFields("Firma").PivotItems
        If pvtItm.Visible Then
            ValgtListe = ValgtListe & pvtItm & ", "
        End If
    Next
    If ValgtListe <> "" Then
        Range("A1").Value = Left(ValgtListe, Len(ValgtListe) - 2)
    End If
End Sub

Husk at erstatte med dine egne navne.

Man kan også sætte en hændelseskode op, så det sker automatisk

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    Dim PvtTbl As PivotTable
    Dim pvtItm As PivotItem
    Set PvtTbl = Target
    Dim ValgtListe As String
    For Each pvtItm In PvtTbl.PivotFields("Firma").PivotItems
        If pvtItm.Visible Then
            ValgtListe = ValgtListe & pvtItm & ", "
        End If
    Next
    If ValgtListe <> "" Then
        Range("A1").Value = Left(ValgtListe, Len(ValgtListe) - 2)
    End If
End Sub

Jeg har lagt en fil til dig her
https://www.it-fjernundervisning.dk/info/eksperten-svar
så du kan se det køre
Avatar billede overgreat Forsker
31. januar 2018 - 23:24 #2
Det er perfekt løsning i forhold til den fil du har lagt...

Jeg får dog en type-mismatch fejl når jeg bruger det på mit ark?!
Den markerer gult på følgende linje (under debug)
If pvtItm.Visible Then

Kan du finde min fejl?
Min konvertering af koden blev som følger:


Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    Dim PvtTbl As PivotTable
    Dim pvtItm As PivotItem
    Set PvtTbl = Target
    Dim ValgtListe As String
    For Each pvtItm In PvtTbl.PivotFields("ID og skabelonnavn").PivotItems
        If pvtItm.Visible Then
            ValgtListe = ValgtListe & pvtItm & ", "
        End If
    Next
    If ValgtListe <> "" Then
        Range("A7").Value = Left(ValgtListe, Len(ValgtListe) - 2)
    End If
End Sub
01. februar 2018 - 06:01 #3
Kan du sende mig filen (evt. en der er renset for følsomme data)?
thor@it-fjernundervisning.dk
01. februar 2018 - 12:01 #4
Det ser ud til, at der er en bug på dette område i Excel 2010 VBA.


Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    Dim PvtTbl As PivotTable
    Dim pvtItm As PivotItem
    Set PvtTbl = Target
    Dim ValgtListe As String
    Dim s As String
    On Error Resume Next
    For Each pvtItm In PvtTbl.PivotFields("ID og skabelonnavn").PivotItems
        If pvtItm.Visible Then
            ValgtListe = ValgtListe & pvtItm & ", "
        End If
    Next
    If ValgtListe <> "" Then
        Range("A7").Value = Left(ValgtListe, Len(ValgtListe) - 2)
    End If
End Sub


ser ud til at køre.

OBS - man bør IKKE bruge On Error Resume Next!
Avatar billede overgreat Forsker
01. februar 2018 - 13:17 #5
Det virker i Excel 2010 - eneste lille detalje er, at alle søgninger starter med en gang at skrive:

#N/A... hvorefter den perfekt skriver det man har valgt.

Det er til at leve med, men kan man lave lille tilpasning så den forbliver væk?
01. februar 2018 - 13:20 #6
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    Dim PvtTbl As PivotTable
    Dim pvtItm As PivotItem
    Set PvtTbl = Target
    Dim ValgtListe As String
    Dim s As String
    On Error Resume Next
    For Each pvtItm In PvtTbl.PivotFields("ID og skabelonnavn").PivotItems
        If pvtItm.Visible Then
            ValgtListe = ValgtListe & pvtItm & ", "
        End If
    Next
  ValgtListe = Replace(ValgtListe, "#N/A", "")
    If ValgtListe <> "" Then
        Range("A7").Value = Left(ValgtListe, Len(ValgtListe) - 2)
    Else
          Range("A7").Value = ""
    End If
End Sub

Ikke testet...
Avatar billede overgreat Forsker
05. februar 2018 - 12:09 #7
en kæmpe tak!
05. februar 2018 - 12:17 #8
så lidt :)
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester