|
本帖最后由 hzruziniu 于 2019-10-9 10:29 编辑
这是一个窗体三级联动下拉,代码如下
- Option Explicit
- Dim arr
- Dim d As Object
- Dim dic As Object
- Private Sub ComboBox1_Change()
- If ComboBox3.Text = Empty Or ComboBox1.Text = Empty Then Exit Sub
- With ComboBox2
- .Clear
- .List = Split(d(ComboBox3.Text)(ComboBox1.Text), "!")
- .ListIndex = -1
- End With
- Me.TextBox1.Text = ""
- End Sub
- Private Sub ComboBox2_Change()
- If ComboBox3.Text = Empty Or ComboBox1.Text = Empty Or ComboBox2.Text = Empty Then Exit Sub
- Dim j&
- Dim findrow As Long
- findrow = dic(ComboBox3.Text & ComboBox1.Text & ComboBox2.Text)
- Me.TextBox1.Text = arr(findrow, 2)
- End Sub
- Private Sub ComboBox3_Change()
- If ComboBox3.Text = Empty Then Exit Sub
- With ComboBox1
- .Clear
- .List = d(ComboBox3.Text).keys
- .ListIndex = 0
- Me.TextBox1.Text = ""
- End With
- End Sub
- Private Sub UserForm_Initialize()
- Dim R&, i&
- With Sheet1
- R = .Range("A65536").End(3).Row
- ' If R < 2 Then MsgBox "没有可供查询单数据!": Exit Sub
- arr = .Range("A1:D" & R).Value
- End With
- Set d = CreateObject("Scripting.Dictionary")
- Set dic = CreateObject("Scripting.Dictionary")
- For i = 1 To UBound(arr)
- If Not d.exists(arr(i, 1)) Then Set d(arr(i, 1)) = CreateObject("Scripting.Dictionary")
- If Not d(arr(i, 1)).exists(arr(i, 3)) Then
- d(arr(i, 1))(arr(i, 3)) = arr(i, 4)
- Else
- d(arr(i, 1))(arr(i, 3)) = d(arr(i, 1))(arr(i, 3)) & "!" & arr(i, 4)
- End If
- dic(arr(i, 1) & arr(i, 3) & arr(i, 4)) = i
- Next
- ComboBox3.List = d.keys
- ComboBox3.ListIndex = 0
- End Sub
复制代码 |
|