Question

我有一个数据透视表和一个在2个日期之间进行过滤的按钮。单击按钮时出现错误 1004 Application Defined或Object Defined错误

我发现错误是由于某些行的源单元格中的某些非日期值引起的。当我将其更改为日期值时，代码可以正常工作。

我想知道有什么办法可以忽略这些值，即非日期值会被忽略并且不在过滤器中使用？目前，该错误使宏无法继续运行。

这是我的代码

Dim Invoice_Start_Date As Date
Dim Invoice_End_Date As Date
Invoice_Start_Date = CDate(Worksheets("Despatch Template").Cells(17, "F").Value)
Invoice_End_Date = CDate(Worksheets("Despatch Template").Cells(17, "G").Value)
Sheets("Despatch Template").Select

MsgBox IsDate(Invoice_End_Date)
MsgBox IsDate(Invoice_Start_Date)

ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
ActiveSheet.PivotTables("PivotTable1").PivotFields("DESPATCH 
DATE").ClearAllFilters
ActiveSheet.PivotTables("PivotTable1").PivotFields("DESPATCH 
DATE").PivotFilters.Add2 _
Type:=xlDateBetween, Value1:=CLng(Invoice_Start_Date), 
Value2:=CLng(Invoice_End_Date)

Answer 1

下面的代码调用一个函数，如果从“调度模板”中检索的值不是日期，则该函数将返回“不为真”，并且该行将不被处理。我已经将其构造为可以循环执行，但您可能可以将方法调整为略有不同的应用程序。

Private Sub CheckDate()

    Dim Dstart As Variant                       ' invoice start date
    Dim Dend As Variant

    If GetDate(17, 6, Dstart) Then
        If GetDate(17, 7, Dend) Then
            With Worksheets("Despatch Template").PivotTables("PivotTable1")
                .PivotCache.Refresh
                ' does this field name really have a blank at its end?
                With .PivotFields("DESPATCH Date ")
                    .ClearAllFilters ""
                    .PivotFilters.Add2 Type:=xlDateBetween, _
                                       Value1:=Dstart, _
                                       Value2:=Dend
                End With
            End With
        End If
    End If
End Sub

Private Function GetDate(R As Long, _
                         Clm As Long, _
                         Dat As Variant) As Boolean

    Dat = Worksheets("Despatch Template").Cells(R, Clm).Value
    If IsDate(Dat) Then
        Dat = CLng(Dat)
        GetDate = True
    End If
End Function

以上代码未经测试。编辑31/01/2019 ================= 下面的代码将标识不包含日期的单元格。除了显示消息框外，您还可以采取纠正措施。

Private Sub CorrectDates()

    Const Clm As Long = 3               ' your dates column (3 = C)
    Const FirstDataRow As Long = 2      ' presuming row 1 to hold captions

    Dim Ws As Worksheet
    Dim Dat As Variant
    Dim Rl As Long                      ' last used row in column Clm
    Dim R As Long

    Set Ws = ActiveSheet                ' change as appropriate
    With Ws
        Rl = .Cells(.Rows.Count, Clm).End(xlUp).Row
        For R = FirstDataRow To Rl
            If Not GetDate(.Cells(R, Clm), Dat) Then
                MsgBox "Cell " & .Cells(R, Clm).Address & " is not a date." & vbCr & Dat
            End If
        Next R
    End With
End Sub
Private Function GetDate(Cell As Range, _
                         Dat As Variant) As Boolean

    Dat = Cell.Value
    If IsDate(Dat) Then
        Dat = CLng(Dat)
        GetDate = True
    End If
End Function

Answer 2

您可以在源数据中过滤"*"来查找非日期值，并使用WorksheetFunction.CountIf为标准的"*"来检查该列中有多少。

如果它大于1（标题），那么您将显示一条错误消息，显示为无效行过滤的源数据，并告诉用户对其进行修复。

如果所有其他方法均失败，请遍历PivotItem中的每个PivotField，然后手动设置PivotItem.Visible的值。在执行此操作时，您可能需要确保PivotTable.ManualUpdate是True，以便它不会尝试重新计算字段中每个项目的数据透视表。

示例代码：

Dim pTable AS PivotTable, pItem As PivotItem

Set pTable = ActiveSheet.PivotTables("PivotTable1")

pTable.ManualUpdate = True

pTable.PivotFields("DESPATCH DATE").ClearAllFilters
For Each pItem In pTable.PivotFields("DESPATCH DATE")
    If IsDate(pItem.Value) Then
        If pItem.Value >= Invoice_Start_Date AND pItem.Value <= Invoice_End_Date Then
            pItem.Visible = True
        Else
            pItem.Visible = False
        End If
    Else
        pItem.Visible = False
    End If
Next pItem

pTable.ManualUpdate = False
pTable.Update

由于非日期值导致过滤数据透视表VB错误

2 个答案: