定制Excel选择性输入列表：[3]VBA分级连选法

1、插入用户窗体

参考上期方法插入一个用户窗体，在属性窗口中将其名称改为“F2”，标题（Caption）改为“地址连选”，背景色设置为浅绿色。

2、插入控件

在窗体F2中插入三个标签、三个复合框（也叫下拉列表框）、一个按钮，调整好大小、位置。在属性窗口中将三个标签的BackStyle属性值设置为1，Caption属性分别设置为：“省/自治区/直辖市”、“市”、“县/区”，将三个复合框的名称分别改为：CB1、CB2、CB3，将命令按钮的名称改为confirm。其它属性使用默认值即可。

3、窗体程序设计

双击窗体F2进入代码窗口，开始下一个环节：窗体程序设计。

4、窗体程序设计——UserForm_Activate()事件

'当窗体被激活时触发该事件，在事件过程中给复合框CB1赋值省级名称（数据存放在“省市县”工作表b2:b34区域），设置窗体显示位置为单元格跟随，将CB2、CB3置为不可用状态（此时一级选项尚未选择）。

Private Sub UserForm_Activate()

   CB1.List = Sheets("省市县").Range("b2:b34").Value

   F2.Top = ActiveCell.Top + 50

   F2.Left = ActiveCell.Left + ActiveCell.Width + 25

   CB2.Enabled = False

   CB3.Enabled = False

End Sub

5、窗体程序设计——CB1_Change()事件

'当完成一级选项的选择时触发该事件。在事件过程中激活CB2，并给其赋值二级名称。通过全局变量“id1”将所选一级名称的编号传递给CB2_Change()事件。

Dim Id1 As String

Private Sub CB1_Change()

  For i = 2 To 34

     If Sheets("省市县").Cells(i, 2).Value = CB1.Value Then

        CB2.Enabled = True:  CB2.Clear

        Id1 = Sheets("省市县").Cells(i, 1)

        Exit For

     End If

  Next i

  If i > 34 Then

     CB2.Enabled = False:  CB3.Enabled = False

  Else

     For i = 37 To 3401

        If Sheets("省市县").Cells(i, 4) = Id1 Then

           CB2.AddItem Sheets("省市县").Cells(i, 2).Value

        End If

     Next i

  End If

End Sub

6、窗体程序设计——CB2_Change()事件

'当完成二级选项的选择时触发该事件。在事件过程中激活CB3，并给其赋值三级名称。

Private Sub CB2_Change()

With Sheets("省市县")

   For i = 36 To 3401    '定位一级数据大块

      If .Cells(i, 1).Value = Id1 Then Exit For 

   Next i

   Do While .Cells(i, 1) <> ""    '定位二级数据小块

      If .Cells(i, 4) = Id1 And .Cells(i, 2) = CB2.Value Then

         id2 = .Cells(i, 1):   Exit Do

      End If

      i = i + 1

   Loop

   If .Cells(i, 1) = "" Then

      CB3.Enabled = False

   Else

      CB3.Enabled = True: i = i + 1: CB3.Clear    '激活CB3

      Do While .Cells(i, 4) = id2   '将三级数据赋值给CB3

         CB3.AddItem .Cells(i, 2).Value: i = i + 1

      Loop

   End If

End With

End Sub

7、窗体程序设计——confirm_Click()事件

'当点击命令按钮时触发该事件。在事件过程中将三级选项的值合并在一起赋值给当前单元格，之后卸载窗体F2。

Private Sub confirm_Click()

   ActiveCell.Value = CB1.Value & CB2.Value & CB3.Value

   Unload F2

End Sub

8、工作表程序设计

在VBA工程窗口中双击需调用F2窗体的工作表 ，进入其代码窗口，输入下面的程序。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim EndRow As Single

EndRow = Range("a65536").End(xlUp).Row

If Target.Row > 1 And Target.Row <= EndRow And _

   Target.Column = 4 And Target.Rows.Count = 1 _

      Then F2.Show

End Sub