Excel VBA 下拉選單切換連動 (2)

繼前一篇 Excel VBA 下拉選單切換連動 (1)，內容一樣是Excel VBA下拉選單選的連動，只是這是要用資料驗證中的清單功能來做，這次的功能是第一個combobox選擇年月，第二個combobox將以選到的年月顯示當年度到年底剩下的月份，依舊使用 篩選 + 事件來組合。
在ThisWorkbooks加入

Private Sub Workbook_Open()
    日期產生
    第一層清單產生
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Name = "資料顯示" Then
        If Target.Address = "$A$1" Then
            第二層清單產生
        ElseIf Target.Address = "$F:$F" Then
            If Workbooks(1).Sheets(1).Cells(Rows.count, "F").End(xlUp).Row = 1 Then
                Workbooks(1).Sheets(1).Cells(1, 2).Value = ""
            End If
        End If
        Debug.Print Target.Address
    End If
End Sub

在Module1中加入

Sub 日期產生()
    Sheets(2).Cells(1, 1) = "日期"

    For i = 2 To 13
        Sheets(2).Cells(i, 1) = Format(DateAdd("m", i - 1, DateSerial(Year(Date), 0, 1)), "ee/mm")
    Next
End Sub

Sub 第一層清單產生()
    Dim listcount1 As Integer
    
    Workbooks(1).Sheets(1).Columns(5).Clear
    
    With Workbooks(1).Sheets(2)
        .Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Workbooks(1).Sheets(1).Range("E1"), Unique:=True
    End With

    With Workbooks(1).Sheets(2)
        .Range(.Cells(2, "A").Address, .Cells(Rows.count, "A").End(xlUp).Address).Name = "日期1"
    End With
    
    '設定"資料驗證"中的清單
    With Workbooks(1).Sheets(1).Range("A1").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
             Operator:=xlBetween, Formula1:="=日期1"
    End With
    Workbooks(1).Sheets(1).Cells(1, 1).Value = Workbooks(1).Sheets(2).Cells(2, "A").Value
    Workbooks(1).Sheets(1).Cells(1, 2).Value = Workbooks(1).Sheets(1).Cells(2, "F").Value
End Sub

Sub 第二層清單產生()
    Dim listcount1 As Integer
    
    Workbooks(1).Sheets(1).Columns(6).Clear
    
    過濾日期

    With Workbooks(1).Sheets(1)
        .Range(.Cells(2, "F").Address, .Cells(Rows.count, "F").End(xlUp).Address).Name = "日期2"
    End With
    
    '設定"資料驗證"中的清單
    With Workbooks(1).Sheets(1).Range("B1")
        .Clear
        With .Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                 Operator:=xlBetween, Formula1:="=日期2"
        End With
        Workbooks(1).Sheets(1).Cells(1, 2).Value = Workbooks(1).Sheets(1).Cells(2, "F").Value
    End With
End Sub

Sub 過濾日期()
    Dim tmp, line
    Dim i As Integer, j As Integer, count As Integer, column As Integer
    
    With Workbooks(1).Sheets(2)
        column = .Cells(1, Columns.count).End(xlToLeft).column
        With .UsedRange
  
            .AutoFilter Field:=.Cells(1, "A").column, Criteria1:=">=" & Sheets(1).Cells(1, 1)
            
            '選出符合條件的資料
            Set tmp = .Resize(.Rows.count).SpecialCells(xlCellTypeVisible)
            count = 1
            For Each line In tmp.Areas
                For i = 1 To line.Rows.count
                    For j = 1 To 1
                        'Debug.Print line(i, j).Value
                        Sheets(1).Cells(count, "F").Value = line(i, j).Value
                    Next
                    count = count + 1
                Next
            Next
        End With
        
        '關閉篩選
        .AutoFilterMode = False
    End With
End Sub

畫面。

檔案連結。