Question

excel表VBA中用代码如何建立多级combobox下拉菜单

1，就是从range("C5:F" & [f65536].end(3).row)里提取数据，C列直接提取key 值给comboboxhd1.
2，运行后根据comboboxhd1的内容去查找C列中含有comboboxhd1的内容对应的D列单元格组成新的数组，成组将其唯一化后给comboboxcp1，形成二级下拉菜单；
3，根据comboboxcp1的内容去查找D列中含有comboboxcp1的内容对应的E列单元格组成新的数组将其唯一化后给comboxkf1，形成二级下拉菜单
4，(根据comboboxcp1的内容去查找D列和comboboxkf1的内容去查找E列)两个条件对应的F列单元格，形成三级下拉菜单，将其值唯一化给产品特性comboboxtx1
说明：comboboxhd1是厚度索引，我有几千条数据，分成十几类后，我找起来就非常容易
comboboxcp1是厚度分类后的产品品名，再唯一化，也就是十几类。也是为了方便查找
comboboxkf1是产品的宽幅，每个产品下只有几个宽幅，我只需要根据产品品名去查找
comboboxtx1是产品的特性，每个产品，不同宽幅，有不同特性。我将其引入做为三级下拉菜单
总思路是，我做流水帐时为防止我的仓库目录里没有而导致抓取数据不全，通过用户窗体将其用combobox来赋值，精准，且不用建附表，方便录入等。
Private Sub UserForm_Initialize()Dim i&, Myr&, arrDim d, kSet d = CreateObject("Scripting.Dictionary")Myr = Sheets("领退入汇总").[d65536].End(xlUp).Rowarr = Sheets("领退入汇总").Range("c6:d" & Myr)For i = 6 To UBound(arr)d(arr(i, 1)) = arr(i, 2)Nextk = d.KeysComboBoxhd1.List() = kComboBoxhd2.List() = kComboBoxhd3.List() = kComboBoxhd4.List() = kComboBoxhd5.List() = kComboBoxhd6.List() = kSet d = NothingEnd Sub第一段代码是这样的，得到的结果是如上图所示，comboboxhd1的值即key值杂乱无序，key可以排序吗，后面的二级和三级如何设置

Answer 1

　　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

　　效果图:

Answer 2

给你个思路：
for i=1 to 行数
if cells(i,"c")＝comboboxhd1值 then arr(n)=cells(i,"D"):n=n+1
next
数组下标可用表函数 countif 先计算
用redim 重定义
排序问题，可先对数组排序或者在添加到组合框时循环确定放置位置

Answer 3

很好做的，不管是前面单元格里面，还是VBA都比较好做，
不过快下班了，hoho~~~

追问

麻烦你帮忙做下，感激不尽