修改二级下拉菜单

lufabao

''一级下拉菜单
Private Sub UserForm_Initialize()
Set d = CreateObject("Scripting.Dictionary")
    i1 = [a65536].End(xlUp).Row
    arr1 = Range("A6:A" & i1)
    For i1 = 1 To UBound(arr1)
    s = d(arr1(i1, 1))
Next
UserForm1.ComboBox1.List = Application.Transpose(d.keys)
Set d = Nothing
ComboBox1.ListIndex = 0
End Sub


''二级下拉菜单
Private Sub ComboBox1_Change()
Dim myAddress As String
Dim rng As Range
Dim mymsg As Integer

ListBox1.Clear
With Range("A:A")
    Set rng = .Find(What:=ComboBox1.Text)
    If Not rng Is Nothing Then
        myAddress = rng.Address
        Do

            ListBox1.AddItem rng.Offset(, 1)
            Set rng = .FindNext(rng)
        Loop While Not rng Is Nothing And rng.Address <> myAddress
    End If
End With
End Sub

大灰狼1976

你的下拉菜单功能都实现了，还想修改什么？
如果要查询代码的话，查询什么内容，怎么输出你应该说明一下。
另，提个建议，既然你会用字典，为什么不在提取A列不重复值的同时就记录一下行号，
后面就不用FIND,FINDNEXT那么麻烦了。