Ошибка фильтрации VB сводной таблицы из-за не датированных значений - PullRequest
Новая
       6

Ошибка фильтрации VB сводной таблицы из-за не датированных значений

0 голосов
/ 30 января 2019

У меня есть сводная таблица и кнопка для фильтрации между 2 датами.Когда я нажимаю кнопку, я получаю сообщение об ошибке 1004 «Определено приложением» или «Определено объектом»

Я обнаружил, что ошибка произошла из-за некоторых значений даты в исходных ячейках в некоторых строках ..измените их на значения даты, код работает правильно.

То, что я хотел бы знать, есть ли способ, которым я могу игнорировать эти значения, то есть значения без даты игнорируются и не используются в фильтре?В настоящее время ошибка останавливает продолжение макроса.

вот код, который у меня есть 

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)

Ответы [ 2 ]

0 голосов
/ 30 января 2019

Вы можете отфильтровать по "*" в своих Исходных данных, чтобы найти значения без даты, и использовать 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
0 голосов
/ 30 января 2019

Приведенный ниже код вызывает функцию, которая будет возвращать значение «Не верно», если значение, полученное из шаблона отправки, не является датой, и это приводит к тому, что строка не обрабатывается.Я построил его для выполнения в цикле, но вы, вероятно, сможете адаптировать методы для немного разных приложений. 

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
...