用VBA Excelselect开始date – 结束date

我的代码有些麻烦 我想用VBAbuttonselect开始date和结束date。

这是我的代码。 有人可以帮助我吗? 非常感谢…

(对不起,我的英语不好)。

我的代码:

Sub CARI() Dim objname As String Dim jumpv As Integer Dim I As Integer Dim S1 As Date Dim S2 As Date Application.DisplayAlerts = False Application.ScreenUpdating = False Sheets("Dashboard").Select objname = Cells(5, 5).Value S1 = Cells(6, 4).Value S2 = Cells(6, 9).Value jumpv = 4 Worksheets("PV").Activate For I = 4 To jumpv Application.StatusBar = "Loading.. ( " & Round(I / jumpv * 100, 0) & ")%" Sheets("PV").Select ActiveSheet.PivotTables("PV" & I).PivotFields("REGION").ClearAllFilters ActiveSheet.PivotTables("PV" & I).PivotFields("REGION").CurrentPage = objname ActiveSheet.PivotTables("PV" & I).PivotFields("DAY").ClearAllFilters ActiveSheet.PivotTables("PV" & I).PivotFields("DAY").PivotFilters.Add _ Type:=xlDateBetween, Value1:=S1, Value2:=S2 ActiveSheet.PivotTables("PV" & I).PivotFields("DAY").AutoSort _ xlAscending, "DAY" Next I Sheets("Dashboard").Select Application.StatusBar = "" MsgBox "Done!" End Sub 

捕获PV表

尝试下面的代码,在代码中的解释作为评论:

 Option Explicit Sub CARI() Dim objname As String Dim jumpv As Integer Dim I As Integer Dim S1 As Date Dim S2 As Date Application.DisplayAlerts = False Application.ScreenUpdating = False With Sheets("Dashboard") ' <-- use With instead of Activate or Select the sheet objname = .Cells(5, 5).Value S1 = .Cells(6, 4).Value S2 = .Cells(6, 9).Value End With jumpv = 4 With Worksheets("PV") For I = 4 To jumpv Application.StatusBar = "Loading.. ( " & Round(I / jumpv * 100, 0) & ")%" .PivotTables("PV" & I).PivotFields("REGION").ClearAllFilters .PivotTables("PV" & I).PivotFields("REGION").CurrentPage = objname .PivotTables("PV" & I).PivotFields("DAY").ClearAllFilters ' when filtering dates, safest way is to covert to Double (their actual value, not their format) .PivotTables("PV" & I).PivotFields("DAY").PivotFilters.Add _ Type:=xlDateBetween, Value1:=CDbl(S1), Value2:=CDbl(S2) .PivotTables("PV" & I).PivotFields("DAY").AutoSort xlAscending, "DAY" Next I End With Sheets("Dashboard").Select Application.StatusBar = "" Application.DisplayAlerts = True Application.ScreenUpdating = True MsgBox "Done!" End Sub