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

Posted 2023-03-28

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可以排序吗，后面的二级和三级如何设置

　　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

　　效果图:

参考技术A 给你个思路：
for i=1 to 行数
if cells(i,"c")＝comboboxhd1值 then arr(n)=cells(i,"D"):n=n+1
next
数组下标可用表函数 countif 先计算
用redim 重定义
排序问题，可先对数组排序或者在添加到组合框时循环确定放置位置本回答被提问者采纳 参考技术B 很好做的，不管是前面单元格里面，还是VBA都比较好做，
不过快下班了，hoho~~~追问

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

在excel中用vba实现与sql数据库的数据比较

先建立一个sheet通过数据页签中自其它来源,将数据库中的资料导入。然后再建立一个sheet通过数据页签中的现有连接，然后通过sql语句就可以比较那两个sheet中的内容了。以后直接点击刷新数据就可以了 参考技术A 我的方法是:
先在Excel里建立一个来自SQL的外部数据查询，把SQL的approve表的数据导入Excel中(一般建议根据“受理编号”升序排列)，然后在用vlookup函数查找。
假设Excel中受理编号字段为第一列，从SQL导出来的数据放在H1开始的字段里，这函数为:
=vlookup(A1,H:J,2,FALSE)
则如果有重复就会返回重复编号右列的数据。
如果你想要其他列的数据，改一下比较区域，和列数就可以了