ExcelVBA字典实现窗体二级下拉菜单

yingzhijj 2016-05-25

展开全文

ExcelVBA字典实现窗体二级下拉菜单

问题提出:
选择确定ComboBox1中的数值后，ComboBox2的下拉列表自动引用ComboBox1中数值对应的列的内容。如何能做到
我现在想在加一重判断：就是判断ComboBox2中的数值，如果是原来ComboBox1对应列中已有的值，就直接向下进行，如果原来ComboBox1对应列中没有该值，自动添加到该列最下一个非空行之后再向下执行。

字典的引用:

窗体代码如下:
Public Arr, Dic As New Dictionary    '声明为公共变量,引用“Microsoft Scripting Runtime”
Private Sub UserForm_Initialize() '窗体初始化事件
    Dim Brr
    Arr = Sheet1.Range("A1").CurrentRegion.Value    'A1单元格已用区域
    For i = 1 To UBound(Arr, 2)    '循环标题，并添加到字典
        If Not Dic.Exists(Arr(1, i)) Then    '字典中不存在关键字
            Dic.Add Arr(1, i), Dic.Count + 1    '添加关键字,Item为索引
        End If
    Next
    Brr = Dic.Keys
    Me.ComboBox1.Clear    '清除列表框1条目
    For i = 0 To UBound(Brr) - 1    '列表框1添加条目
        Me.ComboBox1.AddItem Brr(i)
    Next
End Sub
Private Sub ComboBox1_DropButtonClick() '列表框1下拉事件
    Dim Brr
    If Me.ComboBox1.Text = "" Then Exit Sub    '如果列表框1为空，就退出过程
    Me.ComboBox2.Clear    '清空列表框2条目
    If Dic.Exists(Me.ComboBox1.Text) Then '如果列表框的关键字,在字典中有记录
        Brr = Application.WorksheetFunction.Index(Arr, 0, Dic(Me.ComboBox1.Text)) '用Index函数取出整列数据
        For i = 2 To UBound(Brr, 1)    '列表框2添加条目
            Me.ComboBox2.AddItem Brr(i, 1)    '列表框2添加条目
        Next
    End If
End Sub
Private Sub CommandButton1_Click() '按钮1单击事件
    If Me.ComboBox1.Text = "" Or Me.ComboBox2.Text = "" Then Exit Sub    '如果列表框1,2为空，就退出过程
    Dim Brr, Crr
    Brr = Application.WorksheetFunction.Index(Arr, 0, Dic(Me.ComboBox1.Text))    '用Index函数取出整列数据
    Crr = VBA.Filter(Application.Transpose(Brr), Me.ComboBox2.Text, True)    '取出匹配列表框2的值
    If UBound(Crr) = -1 Then '如果有列表框2的值,数组不会为-1 ,'如果列表框2中没有此关键字,往原数据添加此关键字
        Sheet1.Cells(Rows.Count, Dic(Me.ComboBox1.Text)).End(xlUp).Offset(1).Value = Me.ComboBox2.Text
    End If
    Sheet1.Cells(Rows.Count, 10).End(xlUp).Offset(1).Value = Me.ComboBox2.Text    '+ Me.ComboBox1.Text '把数据写入单元格
    Me.ComboBox1.Text = "": Me.ComboBox2.Text = ""    '列表框1，2显示为空白
    Me.ComboBox1.Clear: Me.ComboBox2.Clear    '清空列表框1，2的条目
    Call UserForm_Initialize    '初始化窗体，为下一次录入数据准备
End Sub