Question

标题是

。对于每个月更新版本，列字段和行字段必须按月进行。

Sub SetDatesforAllPvt()

Application.ScreenUpdating = False

Dim i, j, k As Integer
Dim ipvt As PivotTable
Dim isheet As Worksheet
Dim cutoffdate As Date

cutoffdate = DateSerial(ActiveWorkbook.Sheets("Slicers New").Range("E4").Value - 3, ActiveWorkbook.Sheets("Slicers New").Range("E7").Value + 1, 1)


'For i = 1 To ActiveWorkbook.Sheets.Count
 '   Set isheet = ActiveWorkbook.Sheets(i)
 Set isheet = ActiveSheet

    For j = 1 To isheet.PivotTables.Count
    Set ipvt = isheet.PivotTables(j)
    'ipvt.PivotCache.MissingItemsLimit = xlMissingItemsNone
    'ipvt.RefreshTable

    With ipvt.PivotFields("IncurredM")
        .Orientation = xlRowField
        .Position = 1
        .ShowAllItems = True
        For k = 1 To .PivotItems.Count
            If .PivotItems(k) >= cutoffdate Then
                .PivotItems(k).Visible = True
            Else
                .PivotItems(k).Visible = False
            End If
        Next
       ' .Orientation = xlhiddenfield
      '  .Orientation = xlRowField


    End With
    With ipvt.PivotFields("Paid M")
        .Orientation = xlColumnField
        .Position = 1
        .ShowAllItems = True
        For k = 1 To .PivotItems.Count
            If .PivotItems(k) >= cutoffdate Then
                .PivotItems(k).Visible = True
            Else
                .PivotItems(k).Visible = False
            End If
        Next
     '   .Orientation = xlhiddenfield
      '  .Orientation = xlColumnField

    End With

    Next
'Next

End Sub

出于某种原因，在运行上述操作后，当在Excel中打开单个字段时，最新月份旁边有一个复选标记，因此它应该是可见的。但是，月份不包括在列和行中。我必须手动取消选择，然后选择月份，然后数据透视表正确更新并显示最近一个月。我做错了什么？

添加refreshtable或pivotcache.refresh也无济于事。

此外，大约有40-50个表都与不同的切片器互连。大约有20个切片机。当这个脚本通过许多工作表运行时，这段代码需要一段令人难以置信的长时间（我还没有看到完成的结束）。在Excel的底部，它表示运行切片器的东西。关于这个问题的任何建议也将非常感激。

谢谢

Answer 1

您应该始终选择true循环，然后选择false循环。原因是Excel一次只执行一个并且不允许您在数据透视表中选择任何内容，它会出错（或者你有什么）

所以：

Sub SetDatesforAllPvt()

Application.ScreenUpdating = False

Dim i, j, k As Integer
Dim ipvt As PivotTable
Dim isheet As Worksheet
Dim cutoffdate As Date

cutoffdate = DateSerial(ActiveWorkbook.Sheets("Slicers New").Range("E4").Value - 3, ActiveWorkbook.Sheets("Slicers New").Range("E7").Value + 1, 1)

 Set isheet = ActiveSheet

    For j = 1 To isheet.PivotTables.Count
    Set ipvt = isheet.PivotTables(j)

    With ipvt.PivotFields("IncurredM")
        .Orientation = xlRowField
        .Position = 1
        .ShowAllItems = True
        For k = 1 To .PivotItems.Count
            If .PivotItems(k) >= cutoffdate Then
                .PivotItems(k).Visible = True
            End If
        Next

        For k = 1 To .PivotItems.Count
            If .PivotItems(k) < cutoffdate Then
                .PivotItems(k).Visible = False
            End If
        Next

    End With

    With ipvt.PivotFields("Paid M")
        .Orientation = xlColumnField
        .Position = 1
        .ShowAllItems = True
        For k = 1 To .PivotItems.Count
            If .PivotItems(k) >= cutoffdate Then
                .PivotItems(k).Visible = True
            End If
        Next

        For k = 1 To .PivotItems.Count
            If .PivotItems(k) < cutoffdate Then
                .PivotItems(k).Visible = False
            End If
        Next

    End With

  Next

End Sub

这可能会或可能不会解决您的问题，但它也会缓解未来的问题。

对于你的问题，也许建在一个Activeworkbook.RefreshAll会有所帮助。

Answer 2

没关系。我发现所有的桌子都有日期过滤器，这让我感到惊讶，因为我没有设置它。通过删除过滤器，我能够使一切都可见。

Answer 3

关于执行此操作所需的时间长度，您应该在PivotItems循环之前将数据透视表的.ManualUpdate属性设置为TRUE，并在完成后再将其设置为FALSE。这会在每个PivotItem更改后停止数据透视表刷新。

您还应该首先检查PivotItem.Visible状态是否需要更改，因为更改它需要更长的时间来检查它。我在http://dailydoseofexcel.com/archives/2013/11/14/filtering-pivots-based-on-external-ranges/

上发了一篇文章

关于Slicer问题，我还有另外一篇文章通过：http://dailydoseofexcel.com/archives/2015/11/17/filtering-pivottables-with-vba-deselect-slicers-first/

PivotItem已更改为Visible = True，但数据透视表未相应更新

3 个答案: