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

我试图在两个不同的工作表中的两个不同数据透视表中比较和筛选每周分组的日期。我想比较两个表中的日期，如果它们相同，则复制该分组日期并将其放入另一个工作表中。我的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

这段代码比较并复制所有带有月份的日期，即使这些日期不在透视表中。

---

任何帮助都很好，谢谢

此代码使用

数据透视项

的

数据范围

属性仅比较可见的

数据透视项

，以确定数据透视表中是否存在

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

---

你试过提供的答案了吗？