Excel VBA - 带选择案例的FilterMonth

Question

我有一个包含以下代码的组合框。

它会在选择一个月后过滤具有隐形下拉列表的表格。它没有任何问题，但我认为代码非常糟糕。

如何优化？

它也应该始终是当年的月份。实际上它们都是手动定义的。 （APR =“4/30/2017”） 是不是像“四月”这样的AutoFilter可能？

谢谢你的建议！

Private Sub Worksheet_Activate()

    With Me.FilterMonth

    .Clear
    .AddItem "January"
    .AddItem "February"
    .AddItem "March"
    .AddItem "April"
    .AddItem "May"
    .AddItem "June"
    .AddItem "July"
    .AddItem "August"
    .AddItem "September"
    .AddItem "October"
    .AddItem "November"
    .AddItem "December"
     .ListIndex = -1
    End With

End Sub

Private Sub FilterMonth_Change()
Select Case FilterMonth.Value

    Case "January"
        Application.ScreenUpdating = False
        Dim JAN As String
        JAN = "1/31/2017"
        ActiveSheet.Range("A:AZ").AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(1, JAN), VisibleDropDown:=False
        ActiveWindow.ScrollRow = 1
        Application.ScreenUpdating = True
    Case "February"
        Application.ScreenUpdating = False
        Dim FEB As String
        FEB = "2/28/2017"
        ActiveSheet.Range("A:AZ").AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(1, FEB), VisibleDropDown:=False
        ActiveWindow.ScrollRow = 1
        Application.ScreenUpdating = True
    Case "March"
        Application.ScreenUpdating = False
        Dim MRZ As String
        MRZ = "3/31/2017"
        ActiveSheet.Range("A:AZ").AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(1, MRZ), VisibleDropDown:=False
        ActiveWindow.ScrollRow = 1
        Application.ScreenUpdating = True
    Case "April"
        Application.ScreenUpdating = False
        Dim APR As String
        APR = "4/30/2017"
        ActiveSheet.Range("A:AZ").AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(1, APR), VisibleDropDown:=False
        ActiveWindow.ScrollRow = 1
        Application.ScreenUpdating = True
    Case "May"
        Application.ScreenUpdating = False
        Dim MAI As String
        MAI = "5/31/2017"
        ActiveSheet.Range("A:AZ").AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(1, MAI), VisibleDropDown:=False
        ActiveWindow.ScrollRow = 1
        Application.ScreenUpdating = True
    Case "June"
        Application.ScreenUpdating = False
        Dim JUN As String
        JUN = "6/30/2017"
        ActiveSheet.Range("A:AZ").AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(1, JUN), VisibleDropDown:=False
        ActiveWindow.ScrollRow = 1
        Application.ScreenUpdating = True
    Case "July"
        Application.ScreenUpdating = False
        Dim JUL As String
        JUL = "7/31/2017"
        ActiveSheet.Range("A:AZ").AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(1, JUL), VisibleDropDown:=False
        ActiveWindow.ScrollRow = 1
        Application.ScreenUpdating = True
    Case "August"
        Application.ScreenUpdating = False
        Dim AUG As String
        AUG = "8/31/2017"
        ActiveSheet.Range("A:AZ").AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(1, AUG), VisibleDropDown:=False
        ActiveWindow.ScrollRow = 1
        Application.ScreenUpdating = True
    Case "September"
        Application.ScreenUpdating = False
        Dim SEP As String
        SEP = "9/30/2017"
        ActiveSheet.Range("A:AZ").AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(1, SEP), VisibleDropDown:=False
        ActiveWindow.ScrollRow = 1
        Application.ScreenUpdating = True
    Case "October"
        Application.ScreenUpdating = False
        Dim OKT As String
        OKT = "10/31/2017"
        ActiveSheet.Range("A:AZ").AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(1, OKT), VisibleDropDown:=False
        ActiveWindow.ScrollRow = 1
        Application.ScreenUpdating = True
    Case "November"
        Application.ScreenUpdating = False
        Dim NOV As String
        NOV = "11/30/2017"
        ActiveSheet.Range("A:AZ").AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(1, NOV), VisibleDropDown:=False
        ActiveWindow.ScrollRow = 1
        Application.ScreenUpdating = True
    Case "December"
        Application.ScreenUpdating = False
        Dim DEZ As String
        DEZ = "12/31/2017"
        ActiveSheet.Range("A:AZ").AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(1, DEZ), VisibleDropDown:=False
        ActiveWindow.ScrollRow = 1
        Application.ScreenUpdating = True

End Select
End Sub

Answer 1

您的代码可以简化为：

Option Explicit

Private Sub Worksheet_Activate()
    Dim i As Integer
    With Me.FilterMonth
        .Clear
        For i = 1 To 12
            .AddItem Format(DateSerial(Year(Date), i, 1), "mmmm")
        Next i
        .ListIndex = -1
    End With
End Sub

Private Sub FilterMonth_Change()
    Dim iMonth As Integer, sCriteria As String
    iMonth = FilterMonth.ListIndex + 1 ' Selected Month (first item is index zero)
    Application.ScreenUpdating = False
    ' End of selected Month: Use 1st of next month of current year then subtract 1 day
    sCriteria = Format(DateSerial(Year(Date), iMonth + 1, 1) - 1, "m/d/yyyy") ' Or change to the format of your data
    ActiveSheet.Range("A:AZ").AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(1, sCriteria), VisibleDropDown:=False
    ActiveWindow.ScrollRow = 1
    Application.ScreenUpdating = True
End Sub