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

近期遇到網友想要Excel VBA的表單介面做下拉選單選的連動，主要功能從第一個combobox選擇縣市，依顯示名稱過濾出鄉鎮市區，再填到第二個combobox，原生的下拉選單combobox沒連動功能，所以需要想辦法組合出這樣的功能，因此藉由內部既有的功能 篩選 + 事件來組合。
在表單上加入兩個combobox元件，並使用以下程式碼完成下拉選單的連動。
在ThisWorkbooks加入

Private Sub Workbook_Open()
    UserForm1.Show
End Sub

在表單中加入

Private Sub ComboBox1_Change()
    ComboBox2.Clear
    第二層清單產生 ComboBox1.text
    additem2
    ComboBox2.text = ComboBox2.List(0)
End Sub

Private Sub UserForm_Activate()
    郵遞區號取得
    第一層清單產生
    additem1
    ComboBox1.text = ComboBox1.List(0)    
End Sub

Sub additem1()
    Dim row As Integer, i  As Integer
    
    row = Sheets(3).Cells(Rows.count, 1).End(xlUp).row
    For i = 2 To row
        ComboBox1.additem Sheets(3).Cells(i, 1)
    Next
End Sub

Sub additem2()
    Dim row As Integer, i  As Integer
    
    row = Sheets(3).Cells(Rows.count, 2).End(xlUp).row
    For i = 2 To row
        ComboBox2.additem Sheets(3).Cells(i, 2)
    Next
End Sub

在Module1中加入

Sub 郵遞區號取得()

    Dim row As Integer
    
    With Sheets(2).QueryTables.Add(Connection:= _
        "URL;http://campus4.ncku.edu.tw/wwwmenu/program/net/zip.htm", Destination:=Sheets(2).Range("$A$1"))
        .RefreshStyle = xlOverwriteCells
        .WebFormatting = xlWebFormattingNone
        .WebTables = 1
        .Refresh BackgroundQuery:=False
        row = .ResultRange.Rows.count
        .Delete
    End With
    
    Sheets(2).Cells(1, 3) = "縣市"
    Sheets(2).Cells(1, 4) = "鄉鎮市區"
    For i = 2 To row
        Sheets(2).Cells(i, 3) = Mid(Sheets(2).Cells(i, 2), 1, 3)
        Sheets(2).Cells(i, 4) = Mid(Sheets(2).Cells(i, 2), 4, 3)
    Next

End Sub

Sub 第一層清單產生()
    Dim listcount1 As Integer
    
    Workbooks(1).Sheets(3).Cells.Clear
    '進階過濾篩選出不重複的鄉鎮市
    With Workbooks(1).Sheets(2)
        .Range("C:C").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Workbooks(1).Sheets(3).Range("A1"), Unique:=True
    End With

End Sub

Sub 第二層清單產生(text As String)
    Dim tmp, line
    Dim i As Integer, count As Integer
    
    With Workbooks(1).Sheets(2)
        With .UsedRange
            '鄉鎮市篩選
            .AutoFilter Field:=.Cells(1, "C").Column, Criteria1:="=" & text
            
            '選出符合條件的資料
            Set tmp = .Resize(.Rows.count - 1).SpecialCells(xlCellTypeVisible)
            count = 1
            For Each line In tmp.Areas
                For i = 1 To line.Rows.count
                    Sheets(3).Cells(count, 2).Value = line(i, 4).Value
                    count = count + 1
                Next
            Next
        End With
        
        '關閉篩選
        .AutoFilterMode = False
    End With
End Sub

畫面。

檔案連結。