Используйте VBA, чтобы задать для сводной таблицы значение c Дата на основе другого поля

Question

Я перепробовал много итераций, которые нашел в сети, но не могу заставить это работать. У меня есть сводная таблица, которую мне нужно обновлять еженедельно, и мне нужно, чтобы дата была установлена ​​на основе переменной в поле на листе. Дата - это фильтр. Используя приведенный ниже код, я могу изменить дату на конкретную c дату.

Sub Macro7()

'
 ActiveSheet.PivotTables("PivotTable2").PivotFields("[Test_Data].[Date].[Date]" _
        ).ClearAllFilters
    ActiveSheet.PivotTables("PivotTable2").PivotFields("[Test_Data].[Date].[Date]" _
        ).CurrentPageName = "[Test_Data].[Date].&[2020-07-12T00:00:00]"
End Sub

Однако, когда я пытаюсь установить дату для переменной, такой как строка, указывающая на ячейку рабочего листа, содержащую дата, он выдает ошибку, обычно заявляя: «Не удалось установить свойство CurrentPage класса PivotField». Я пробовал много разных вариантов и разный код, но ничего не помогло. D2 - это то место, где дата меняется. Он обновляется на основе формулы. Я также пробовал просто жестко кодировать даты в ячейке, но это тоже не работает. Также пробовали сопоставить форматы даты с сводной таблицей, не помогло. Если это важно, поле извлекает дату последней пятницы. Если бы это помогло, я мог бы вместо этого вставить это в код (я попытался, у меня возникла ошибка, что строка не может быть преобразована в дату).

Sub My_macro()
    Dim str As String
    str = ActiveSheet.Range("d2")
    ActiveSheet.PivotTables("PivotTable2").PivotFields("[Test_Data].[Date].[Date]" _
        ).ClearAllFilters
    ActiveSheet.PivotTables("PivotTable2").PivotFields("[Test_Data].[Date].[Date]").CurrentPage = str
End Sub

Кто-нибудь, пожалуйста, скажите мне, как исправить это? Пытались часами и просто не могли понять. Спасибо. PS - Я попытался загрузить лист, но не могу понять, как, похоже, я могу делать только фотографии, поэтому я загрузил его. Ниже приведена сводная диаграмма, в которой проблема с фильтром даты, а ниже - пример того, что используется для этой сводной таблицы.

Edit: Have shared a sample of the file here: https://www.dropbox.com/sh/4tzrrue0mggf6om/AAAd6024feSdc9MbCd9IZD0Wa?dl=0

Answer 1

Когда вы записываете макрос, вы получите что-то вроде этого

Sub Macro1()
'
' Macro1 Macro
'

'
    ActiveSheet.PivotTables("PivotTable2").PivotFields("[_Data].[Date].[Date]"). _
        ClearAllFilters
    ActiveSheet.PivotTables("PivotTable2").PivotFields("[_Data].[Date].[Date]"). _
        CurrentPage = "[_Data].[Date].&[2019-08-16T00:00:00]"
End Sub

Даже если макрос дал вам этот код, он выдаст ошибку, если вы запустите его напрямую, ничего не меняя.

Решение : Это очень старая проблема, которую можно решить, изменив CurrentPage на CurrentPageName

Теперь изменив его в соответствии с вашими потребностями ...

Sub Sample()
    Dim ws As Worksheet
    Set ws = Sheet1
    
    Dim rngDt As Range
    Set rngDt = ws.Range("D2")
    
    Dim dtString As String
    dtString = Format(rngDt.Value2, "yyyy-mm-dd")
    
    Dim pt As PivotTable
    Set pt = ws.PivotTables("PivotTable2")
    
    Dim pf As PivotField
    Set pf = pt.PivotFields("[_Data].[Date].[Date]")
    
    pf.ClearAllFilters
    pf.CurrentPageName = "[_Data].[Date].&[" & dtString & "T00:00:00]"
End Sub

РЕДАКТИРОВАТЬ

Могу я вас спросить ... как я могу выбрать НЕСКОЛЬКО сводных точек на одном листе и сделать то же самое с их фильтрами, выбрав ту же дату ( ячейка D2) для всех? Просто повторите код, добавив подстановку в названиях, или что-то вроде массива сработает? Еще раз спасибо, отмечая ваш как ответ! - изучение этого материала 2 дня a go

Вы можете сделать это за l oop. Для каждого pt в ws.PivotTables, а затем для каждого pf в pt.PivotFields :) - Siddharth Rout 2 дня a go

Спасибо .... где мне поместить эти строки? Я пробовал пару мест, которые, как мне казалось, имели смысл, но продолжаю получать ошибки. Я буду продолжать пробовать варианты, задаваясь вопросом, нужно ли мне удалить строки 'set pt / pf'? Спасибо. - изучение этого материала 14 часов a go>

У них такое же поле «Дата»? - Siddharth Rout 13 часов go

Да, все они практически идентичны. Те же фильтры. - изучение этого материала 11 часов a go

Вы можете попробовать что-то вроде этого ( Untested )

Sub Sample()
    Dim ws As Worksheet
    Set ws = Sheet1
    
    Dim rngDt As Range
    Set rngDt = ws.Range("D2")
    
    Dim dtString As String
    dtString = Format(rngDt.Value2, "yyyy-mm-dd")
    
    Dim pt As PivotTable
    Dim pf As PivotField
    
    For Each pt In ws.PivotTables
        Set pf = pt.PivotFields("[_Data].[Date].[Date]")
        pf.ClearAllFilters
        pf.CurrentPageName = "[_Data].[Date].&[" & dtString & "T00:00:00]"
    Next pt
End Sub

EDIT

В соответствии с просьбой OP отредактировать этот ответ, поскольку существует несколько точек поворота, в приведенный выше код, наконец, были внесены следующие изменения.

Sub Sample2()
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")

    Dim rngDt As Range
    Set rngDt = ws.Range("F32")

    Dim dtString As String
    dtString = Format(rngDt.Value2, "yyyy-mm-dd")

    Dim pt As PivotTable
    Dim pf As PivotField

    For Each pt In ws.PivotTables
        If pt = "PivotTable2" Then
            Set pf = pt.PivotFields("[_Data].[Date].[Date]")
            pf.ClearAllFilters
            pf.CurrentPageName = "[_Data].[Date].&[" & dtString & "T00:00:00]"
        Else
            Set pf = pt.PivotFields("[Sales_Data].[Date].[Date]")
            pf.ClearAllFilters
            pf.CurrentPageName = "[Sales_Data].[Date].&[" & dtString & "T00:00:00]"
        End If
    Next pt
End Sub

Answer 2

РЕДАКТИРОВАТЬ: Никогда не работал с кубическими полями, но, похоже, это делает то, что вы хотите:

Sub My_macro()
    
    Dim dt As Date, pt As PivotTable, pf As PivotField
    
    dt = ActiveSheet.Range("d2")
    Set pt = ActiveSheet.PivotTables(1)
    
    Set pf = pt.PageFields("[_Data].[Date].[Date]")
    With pf
        .ClearAllFilters
        .CubeField.EnableMultiplePageItems = True
        .VisibleItemsList = _
             Array("[_Data].[Date].&[" & Format(dt, "yyyy-mm-dd") & "T00:00:00]")
    End With

End Sub