Sub minus_den()

Dim dDate As Date

dDate = Range("Date_CDU").Value

dDate = dDate - 1

Range("Date_CDU").Value = dDate

' Cells(1, 1).Value = Cells(1, 1).Value - 1

Фильтр_сводной

End Sub

Sub plus_den()

Dim dDate As Date

dDate = Range("Date_CDU").Value

dDate = dDate + 1

Range("Date_CDU").Value = dDate

' Cells(1, 1).Value = Cells(1, 1).Value + 1

Фильтр_сводной

End Sub

Sub Фильтр_сводной()

Dim oPt As PivotTable

Dim oPf As PivotField

Dim strPfName As String

Dim strVal As String

strPfName = "Дата PSFV"

strVal = FnDatePi(Range("Date_CDU").Value)

For Each oPt In ThisWorkbook.Sheets("Pv_CDU").PivotTables

'Set oPt = ActiveSheet.PivotTables(1)

Set oPf = oPt.PageFields(strPfName)

фильтр = FnФильтр_сводной(oPf, strVal)

Next oPt

End Sub

Function FnФильтр_сводной(ByVal oPf As PivotField, _

ByVal strVal As String) As Boolean

Dim oPi As PivotItem

Dim F_Run As Boolean

EventsChange False

Err.Clear

'проверяем наличие даты

For Each oPi In oPf.PivotItems

If oPi.Value = strVal Then F_Run = True

Next oPi

If F_Run Then

With oPf

.ClearAllFilters

.CurrentPage = strVal

End With

Else

With oPf

.ClearAllFilters

.CurrentPage = "1/10/1900" 'strVal

End With

FnФильтр_сводной = False

Exit Function

End If

If Len(Err.Description) = 0 Then FnФильтр_сводной = True

EventsChange True

End Function

'================================================================================

'### Преобразует дату в басурманский формат

Function FnDatePi(ByVal strDate As String) As String

' m = Split(strDate, "/", -1, vbBinaryCompare)

m = Split(strDate, ".", -1, vbBinaryCompare)

' If Len(m(0)) = 1 Then m(0) = "0" & m(0)

' If Len(m(1)) = 1 Then m(1) = "0" & m(1)

If Left(m(0), 1) = 0 Then m(0) = Right(m(0), Len(m(0) - 1))

If Left(m(1), 1) = 0 Then m(1) = Right(m(1), Len(m(1) - 1))

FnDatePi = m(1) & "/" & m(0) & "/" & m(2)

End Function