比较两个不同数据透视表vba中的分组日期

Question

我正在尝试在两个不同工作表的两个不同数据透视表中比较和过滤每周分组的日期。我想比较两个表中的日期，如果它们相同，则复制该分组日期并将其放入另一个工作表中。我拥有的 VBA 代码正在比较一个月内的所有日期。 例如：

            pivot table 1             pivot table 2
      10/15/2013 - 10/21/2013    10/15/2013-10/21/2013
      10/22/2013 - 10/28/2013    10/22/2013 - 10/28/2013 
      5/27/2014 - 6/2/2014       6/3/2014 - 6/9/2014

当我运行 VBA 时，我想将前两组日期复制到另一个工作表中，因为它们是相同的，而忽略第三组，因为它们不是。每个表中的日期数可能不同。这是我到目前为止的代码

Sub Find()

Dim Pvt1 As PivotTable
Dim Pvt2 As PivotTable
Dim pf1 As PivotField
Dim pf2 As PivotField
Dim pi1 As PivotItem
Dim pi2 As PivotItem
Dim cell As Range


Set Pvt1 = ActiveWorkbook.Worksheets("Total Bloodhound").PivotTables("PivotTable3")
Set Pvt2 = ActiveWorkbook.Worksheets("Total Closed").PivotTables("PivotTable1")
Set pf1 = Pvt1.PivotFields("time")
Set pf2 = Pvt2.PivotFields("time")
Dim index As Integer
index = 1

For Each pi1 In pf1.PivotItems
For Each pi2 In pf2.PivotItems
    If IsEmpty(pi2.Value) Then Exit For
        If pi1.Value = pi2.Value Then
            Worksheets("Sheet1").Cells(index, "A") = pi1.Value
            index = index + 1
    End If
Next pi2
Next pi1

End Sub

此代码比较并复制所有带有月份的日期，即使这些日期不在数据透视表中。 任何帮助都会非常感谢！

Answer 1

此代码仅使用PivotItem 的DataRange 属性比较可见的PivotItems，以确定数据透视表中是否存在

Sub Ptb_CompareAndList()
Const kPFld As String = "time"
Dim Wsh As Worksheet
Dim Pt1 As PivotTable, Pt2 As PivotTable
Dim Pi1 As PivotItem, Pi2 As PivotItem
Dim rDtaRng As Range, lRow As Long

    Rem Set Objects
    With ThisWorkbook
        Set Wsh = .Sheets("Sheet1")
        Set Pt1 = .Sheets("Total Bloodhound").PivotTables("PivotTable3")
        Set Pt2 = .Sheets("Total Closed").PivotTables("PivotTable1")
    End With

    Rem Clear Prior Results
    Wsh.Columns(1).ClearContents

    For Each Pi1 In Pt1.PivotFields(kPFld).PivotItems

        Rem Validate PivotItem
        Set rDtaRng = Nothing
        On Error Resume Next
        Rem Use PivotItem DataRange property to determine if present in the PivotTable
        Set rDtaRng = Pi1.DataRange
        On Error GoTo 0
        If Not rDtaRng Is Nothing Then

            Rem Set PivotItem in PivotTable 2 directly to avoid For...Next
            Set Pi2 = Nothing
            On Error Resume Next
            Set Pi2 = Pt2.PivotFields(kPFld).PivotItems(Pi1.SourceNameStandard)
            On Error GoTo 0
            If Not Pi2 Is Nothing Then
                    Rem List Results
                    lRow = 1 + lRow
                    Wsh.Cells(lRow, 1) = Pi1.Value

    End If: End If: Next

End Sub