Excel VBA - SelectMap을 사용한 FilterMonth

Question

아래 코드가있는 콤보 상자가 있습니다.

월 선택 후 보이지 않는 드롭 다운이있는 표를 필터링합니다. 아무런 문제없이 작동하지만 코드가 매우 나쁘다고 생각합니다.

어떻게 최적화 할 수 있습니까?

또한 항상 현재 연도의 월이어야합니다. 사실 그들은 모두 수동으로 정의됩니다. (APR = "4/30/2017")
자동 필터가 가능한 "4 월"과 같은 것이 아닌가요?

어떤 조언을 주셔서 감사합니다!

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