ExcelHome技术论坛

 找回密码
 免费注册
QQ登录 只需一步,快速开始
新浪微博登陆 只需一步, 快速开始
   
高效办公必会的Office99uu优优 永久免费,网表让Excel秒变数据库 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! 国内首部Excel函数公式学习大典 职场充电黑科技, Office微99uu优优 免费下载Excel行业应用视频
300集Office 2010微99uu优优 Tableau-数据可视化工具 突破Excel限制,用活字格提高效率 12门Excel免费公开课任你学
你的Excel 201099uu优优学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 46006|回复: 145
打印 上一主题 下一主题

[原创] 用一个字典代替字典嵌套完成多级联动功能

  [复制链接]
TA的精华主题TA的得分主题
跳转到指定楼层
1
发表于 2013-11-30 04:03 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
本帖已被收录到知识树中,索引项:数组集合和字典
用一个字典代替字典嵌套完成多级联动功能
用字典嵌套(字典套字典)可以完成多级联动功能,用起来很方便,在数据量不是太大、嵌套级数不多的情况下,速度还是可以的,但如果数据量太大,或嵌套级数太多时,速度会变得很慢,下面用几个例子说明用一个字典,或几个字典代替字典嵌套完成多级联动功能。
一、三级联动列表框
原代码如下(lj1226189坛友所写)
Dim d1 As New Dictionary
Dim d2 As New Dictionary
Dim D4 As New Dictionary
Private Sub UserForm_Initialize()
tt = Timer
   Dim n As Long, i As Long, arr
    n= Sheets("SHEET1").[a65536].End(xlUp).Row
   arr = Sheets("SHEET1").[a1].Resize(n, 3)
   Application.ScreenUpdating = False
   On Error Resume Next
   For i = 1 To n
       D4.Add arr(i, 1) & "", ""
       xx = arr(i, 1) & ""
       yy = arr(i, 2) & ""
       zz = arr(i, 3) & ""
       xh = arr(i, 1) & arr(i, 2)
       If d1.Exists(xx) = False Then Set d1(xx) = New Dictionary '字典嵌套
       d1(xx)(yy) = zz
       If d2.Exists(xh) = False Then Set d2(xh) = New Dictionary '字典嵌套
       d2(xh)(zz) = zz
   Next
   UserForm1.ListBox1.List = d1.Keys
   Application.ScreenUpdating = True
   MsgBox Timer - tt
End Sub
用一个字典实现代码如下:
Dim d As Object
Private Sub UserForm_Initialize()
tt = Timer
   Dim i As Long, arr
   arr = Sheets("Sheet1").Range("A1").CurrentRegion
   Set d = CreateObject("scripting.dictionary")
   For i = 2 To UBound(arr)
       If InStr(d(arr(i, 1)) & ",", "," & arr(i, 2)& ",") = 0 Then d(arr(i, 1)) = d(arr(i, 1)) & ","& arr(i, 2) '如果字典条目中不含有该二级项目,则把一级项目添加到字典键值,该二级项目添加到字典条目,和原条目用逗号隔开
       If InStr(d(arr(i, 1) & vbTab & arr(i, 2)) & ",","," & arr(i, 3) & ",") = 0 Then d(arr(i, 1) &vbTab & arr(i, 2)) = d(arr(i, 1) & vbTab & arr(i, 2)) &"," & arr(i, 3)  '如果字典条目中不含有该三级项目,则把一级项目和二级项目用vbTab连接起来添加到字典键值,把三级项目添加到字典条目,和原条目用逗号隔开
   Next
   ListBox1.List = Filter(d.Keys, vbTab, False) '去掉含有vbTab的元素
   MsgBox Timer - tt

End Sub
附件一——三级联动列表框.rar (87.58 KB, 下载次数: 3957)



该贴已经同步到 zhaogang1960的微博

评分

参与人数 11鲜花 +25 收起 理由
weiyingde + 2
hy397556 + 2 太强大了,学习了,赵版辛苦
yxj01 + 2
vs2010 + 2 优秀作品
Samsea + 2 确实精华,收藏备用
查看全部评分
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏226 分享分享 有用有用7 无用无用1 分享到新浪微博
TA的精华主题TA的得分主题
2
 楼主| 发表于 2013-11-30 04:07 | 只看该作者 |楼主
本帖最后由 zhaogang1960 于 2013-12-6 01:47 编辑

二、用TreeView控件建立目录树
字典嵌套代码由chxw68坛友所写,原代码如下:
Private Sub UserForm_Initialize() '使用此段程序,必须在VBE中先加载"Micerosoft TreeView Conntrol,version6.0"控件。
  Dim d As New Dictionary '建立字典
  Dim i, j, r, c As Integer
  Dim ws As Worksheet
  Dim nodex As Node
  
  With TreeView1 '设置TreeView控件属性
    .Nodes.Clear
    .Style = 6
    .LineStyle = 1
  End With
  Set ws = Worksheets("sheet1")
  r = Cells(Rows.Count, 1).End(xlUp).Row
  arr = Range("a2:d" & r)
  n = 0
  For i = 1 To UBound(arr)
    If Not d.Exists(arr(i, 1)) Then
      Set d(arr(i, 1)) = CreateObject("scripting.dictionary") '一级字典嵌套
    End If
    If Not d(arr(i, 1)).Exists(arr(i, 2)) Then
      Set d(arr(i, 1))(arr(i, 2)) = CreateObject("scripting.dictionary") '二级字典嵌套
    End If
    If Not d(arr(i, 1))(arr(i, 2)).Exists(arr(i, 3)) Then
      Set d(arr(i, 1))(arr(i, 2))(arr(i, 3)) = CreateObject("scripting.dictionary") '三级字典嵌套
    End If
    If Not d(arr(i, 1))(arr(i, 2))(arr(i, 3)).Exists((arr(i, 4))) Then
      Set d(arr(i, 1))(arr(i, 2))(arr(i, 3))(arr(i, 4)) = CreateObject("scripting.dictionary") '四级字典嵌套
    End If
  Next
  TreeView1.Nodes.Clear
  Set nodex = TreeView1.Nodes.Add(, , "乡镇", "乡镇") '添加根节点
  For Each aa In d.Keys
    i = i + 1
    Set nodex = TreeView1.Nodes.Add("乡镇", tvwChild, aa & i, aa) '添加二级节点
    For Each bb In d(aa).Keys
      j = j + 1
      Set nodex = TreeView1.Nodes.Add(aa & i, tvwChild, bb & j, bb) '添加三级节点
      For Each cc In d(aa)(bb).Keys
        k = k + 1
        Set nodex = TreeView1.Nodes.Add(bb & j, tvwChild, cc & k, cc) '添加四级节点
        For Each dd In d(aa)(bb)(cc).Keys
          l = l + 1
          Set nodex = TreeView1.Nodes.Add(cc & k, tvwChild, dd & l, dd) '添加五级节点
        Next
      Next
    Next
  Next
End Sub

用一个字典实现代码如下:
Private Sub UserForm_Initialize()
'本例仅说明可以用一个字典实现多级联动,没有比较速度,因为时间主要浪费在向TreeView写数据
    Dim d As New Dictionary '建立字典
    Dim nodex As Node
    Dim arr, aa, bb, cc, dd, i&, j&
    With TreeView1 '设置TreeView控件属性
        .Nodes.Clear
        .Style = 6
        .LineStyle = 1
        arr = Range("a2:d" & Cells(Rows.Count, 1).End(xlUp).Row)
        For i = 1 To UBound(arr)
            For j = 1 To 3 '从第一级到倒数第二级,用循环表示
                If j = 1 Then s = arr(i, j) Else s = s & vbTab & arr(i, j)
                If Not d.Exists(s) Then
                    d(s) = arr(i, j + 1)
                Else
                    If InStr("," & d(s) & ",", "," & arr(i, j + 1) & ",") = 0 Then d(s) = d(s) & "," & arr(i, j + 1)
                End If
            Next
            '以上用For循环实现下面注释部分设置字典
'            s = arr(i, 1)
'            If Not d.Exists(s) Then
'                d(s) = arr(i, 2)
'            Else
'                If InStr("," & d(s) & ",", "," & arr(i, 2) & ",") = 0 Then d(s) = d(s) & "," & arr(i, 2)
'            End If
'            s = s & vbTab & arr(i, 2)
'            If Not d.Exists(s) Then
'                d(s) = arr(i, 3)
'            Else
'                If InStr("," & d(s) & ",", "," & arr(i, 3) & ",") = 0 Then d(s) = d(s) & "," & arr(i, 3)
'            End If
'            s = s & vbTab & arr(i, 3)
'            If Not d.Exists(s) Then
'                d(s) = arr(i, 4)
'            Else
'                If InStr("," & d(s) & ",", "," & arr(i, 4) & ",") = 0 Then d(s) = d(s) & "," & arr(i, 4)
'            End If
        Next
        .Nodes.Clear
        Set nodex = .Nodes.Add(, , "乡镇", "乡镇") '添加根节点
        For Each aa In Filter(d.Keys, vbTab, False) '字典键值不含vbTab数组
            i = i + 1
            Set nodex = .Nodes.Add("乡镇", tvwChild, aa & i, aa) '添加二级节点
            For Each bb In Split(d(aa), ",")
                j = j + 1
                Set nodex = .Nodes.Add(aa & i, tvwChild, bb & j, bb) '添加三级节点
                For Each cc In Split(d(aa & vbTab & bb), ",")
                    k = k + 1
                    Set nodex = .Nodes.Add(bb & j, tvwChild, cc & k, cc) '添加四级节点
                    For Each dd In Split(d(aa & vbTab & bb & vbTab & cc), ",")
                        l = l + 1
                        Set nodex = .Nodes.Add(cc & k, tvwChild, dd & l, dd) '添加五级节点
                    Next
                Next
            Next
        Next
    End With
End Sub


附件二——建立目录树(字典四级嵌套和用一个字典分别实现).rar (23.35 KB, 下载次数: 1520)

建立目录树(字典四级嵌套和用一个字典分别实现从第一级到倒数第二级,用循环表示).rar (18.86 KB, 下载次数: 1293)

评分

参与人数 3鲜花 +7 技术 +1 收起 理由
蔡明江 + 2 太强大了
wpxxsyzx + 1 优秀作品
YZLSZAJ + 5 优秀作品
查看全部评分
TA的精华主题TA的得分主题
3
 楼主| 发表于 2013-11-30 04:10 | 只看该作者 |楼主
本帖最后由 zhaogang1960 于 2013-12-6 00:20 编辑

三、左键三级菜单,新加一个附件《四级菜单显示最后两级到单元格》
字典嵌套代码如下:
Sub CreatMe() '字典嵌套生成左键树型菜单
    Dim d As Object, i&, j&, k, k2, t, a, l&, arr, x As Object
    Set d = CreateObject("scripting.dictionary")
    arr = Sheets("Sheet1").Range("A1").CurrentRegion
    For i = 2 To UBound(arr)
        If Not d.Exists(arr(i, 1)) Then Set d(arr(i, 1)) = CreateObject("scripting.dictionary") '字典嵌套
        If Len(arr(i, 2)) Then d(arr(i, 1))(arr(i, 2)) = d(arr(i, 1))(arr(i, 2)) & "," & arr(i, 3) '如果二级分类不为空,把三级分类添加到字典条目,并用逗号隔开
    Next
    k = d.keys '一级分类
    On Error Resume Next
    Application.CommandBars("树型菜单").Delete '删除可能存在的"树型菜单"菜单
    With Application.CommandBars.Add("树型菜单", msoBarPopup)
        For i = 0 To UBound(k)
            With .Controls.Add(Type:=IIf(d(k(i)).Count, msoControlPopup, msoControlButton))
                .Caption = k(i)
                .OnAction = IIf(d(k(i)).Count, "", "'显示在活动单元格 """ & k(i) & """'")
                .BeginGroup = True '分组显示
                k2 = d(k(i)).keys '二级分类
                t = d(k(i)).items '三级分类,每个三级分类用逗号隔开
                For j = 0 To UBound(k2)
                    a = Split(t(j), ",")
                    With .Controls.Add(Type:=IIf(Len(t(j)) > UBound(a), msoControlPopup, msoControlButton))
                        .Caption = k2(j)
                        .OnAction = IIf(Len(t(j)) > UBound(a), "", "'显示在活动单元格 """ & k2(j) & """'")
                        For l = 1 To UBound(a)
                            If Len(a(l)) Then
                                With .Controls.Add(Type:=msoControlButton)
                                    .Caption = a(l)
                                    .OnAction = "'显示在活动单元格 """ & a(l) & """'"
                                End With
                            End If
                        Next
                    End With
                Next
            End With
        Next
    End With
End Sub

Sub 显示在活动单元格(s$)
    ActiveCell.Value = s
End Sub

一个字典实现如下:
Sub CreatMe() '一个字典生成左键树型菜单
    Dim d As Object, i&, j&, k, k2, t2, a3, l&, arr, x As Object
    Set d = CreateObject("scripting.dictionary")
    arr = Sheets("Sheet1").Range("A1").CurrentRegion
    For i = 2 To UBound(arr)
        If InStr(d(arr(i, 1)) & ",", "," & arr(i, 2) & ",") = 0 Then d(arr(i, 1)) = d(arr(i, 1)) & "," & arr(i, 2) '如果字典条目中不含有该二级分类,则把一级分类添加到字典键值,该二级分类添加到字典条目,和原条目用逗号隔开
        If Len(arr(i, 2)) Then d(arr(i, 1) & vbTab & arr(i, 2)) = d(arr(i, 1) & vbTab & arr(i, 2)) & "," & arr(i, 3) '如果二级分类不为空,则把一级分类和二级分类用vbTab连接起来添加到字典键值,把三级分类添加到字典条目,和原条目用逗号隔开
    Next
    k = Filter(d.keys, vbTab, False) '一级分类,不含vbTab
    On Error Resume Next
    Application.CommandBars("树型菜单").Delete '删除可能存在的"树型菜单"菜单
    With Application.CommandBars.Add("树型菜单", msoBarPopup)
        For i = 0 To UBound(k)
            t2 = d(k(i)) '二级分类,每个二级分类用逗号隔开
            a2 = Split(t2, ",") '二级分类数组
            With .Controls.Add(Type:=IIf(Len(t2) > UBound(a2), msoControlPopup, msoControlButton)) '二级分类t2都是逗号,即没有实际项目,则msoControlButton
                .Caption = k(i)
                .OnAction = IIf(Len(t2) > UBound(a2), "", "显示在活动单元格")
                .BeginGroup = True '分组显示
                For j = 1 To UBound(a2) '逐个二级分类
                    If Len(a2(j)) Then '如果二级分类不为空
                        t3 = d(k(i) & vbTab & a2(j)) '三级分类,每个三级分类用逗号隔开
                        a3 = Split(t3, ",") '三级分类数组
                        With .Controls.Add(Type:=IIf(Len(t3) > UBound(a3), msoControlPopup, msoControlButton))
                            .Caption = a2(j)
                            .OnAction = IIf(Len(t3) > UBound(a3), "", "显示在活动单元格")
                            For l = 1 To UBound(a3)
                                If Len(a3(l)) Then
                                    With .Controls.Add(Type:=msoControlButton)
                                        .Caption = a3(l)
                                        .OnAction = "显示在活动单元格"
                                    End With
                                End If
                            Next
                        End With
                    End If
                Next
            End With
        Next
    End With
End Sub

Sub 显示在活动单元格()
   ActiveCell.Value = Application.CommandBars.ActionControl.Caption
End Sub

附件三——1左键三级菜单(字典嵌套).rar (44.59 KB, 下载次数: 1069)
附件一——2左键三级菜单(只用一个字典).rar (45.76 KB, 下载次数: 1075)
四级菜单显示最后两级到单元格.rar (45.04 KB, 下载次数: 1116)

评分

参与人数 2鲜花 +7 收起 理由
鄂龙蒙 + 2 优秀作品!4级能否显示到4个单元格?
YZLSZAJ + 5 优秀作品
查看全部评分
TA的精华主题TA的得分主题
4
 楼主| 发表于 2013-11-30 04:13 | 只看该作者 |楼主
四、根据姓名统计出编号出现的记录条数
字典嵌套代码如下:
Sub 字典嵌套()
    Dim d As Object, arr, brr(), i&, j&, lc&, k, t, sh As Worksheet
    Set d = CreateObject("scripting.dictionary")
    For Each sh In Sheets
        If sh.Name <> "汇总" Then
            arr = sh.UsedRange
            For i = 2 To sh.[a65536].End(xlUp).Row
                If Len(arr(i, 1)) Then
                    If Not d.Exists(arr(i, 1)) Then Set d(arr(i, 1)) = CreateObject("Scripting.Dictionary") '字典嵌套
                    d(arr(i, 1))(arr(i, 2)) = d(arr(i, 1))(arr(i, 2)) + 2 '同一个姓名的编号出现的次数,这里为了写入数组方便,每出现一次+2,实际上是实现次数的2倍
                End If
            Next
        End If
    Next
    k = d.keys
    ReDim brr(0 To UBound(k), 2 To 250)
    For j = 0 To UBound(k)
        t = d(k(j)).items
        For i = 0 To UBound(t)
            brr(j, t(i)) = brr(j, t(i)) + 1
            If t(i) > lc Then lc = t(i)
        Next
    Next
    With Sheets("汇总")
        .[a2:a60000] = ""
        .UsedRange.Offset(1, 2).ClearContents
        .[a2].Resize(j) = WorksheetFunction.Transpose(k)
        .[c2].Resize(j, lc + 1) = brr
        Cells(j + 2, 1) = "合计"
        Cells(j + 2, 2).Resize(, lc + 1) = "=SUM(R2C:R" & j + 1 & "C)"
        For i = 3 To lc + 1 Step 2
            Cells(2, i + 1).Resize(j + 1) = "=RC" & i & "/RC2*100"
        Next
    End With
End Sub
两个字典实现代码如下:
Sub 两个字典()
    Dim d As Object, ds As Object, arr, brr&(), crr(), i&, j&, m&, c&, lc&, k, t, r, sh As Worksheet
    Set d = CreateObject("scripting.dictionary")
    Set ds = CreateObject("scripting.dictionary")
    For Each sh In Sheets
        If sh.Name <> "汇总" Then
            arr = sh.UsedRange
            For i = 2 To sh.[a65536].End(xlUp).Row
                If Len(arr(i, 1)) Then
                    r = d(arr(i, 1))
                    If r = "" Then
                        m = m + 1
                        d(arr(i, 1)) = m
                        r = m
                    End If
                    ds(r & vbTab & arr(i, 2)) = ds(r & vbTab & arr(i, 2)) + 2
                End If
            Next
        End If
    Next
    k = ds.keys
    t = ds.items
    ReDim brr(1 To m, 2 To 250)
    For i = 0 To UBound(k)
        j = Split(k(i), vbTab)(0)
        c = t(i)
        brr(j, c) = brr(j, c) + 1
        If c > lc Then lc = c
    Next
    With Sheets("汇总")
        .[a2:a60000] = ""
        .UsedRange.Offset(, 2).ClearContents
        .UsedRange.Borders.LineStyle = xlNone
        .[a2].Resize(m) = WorksheetFunction.Transpose(d.keys)
        .[c2].Resize(m, lc) = brr
        .Cells(m + 2, 1) = "合计"
        .Cells(m + 2, 2).Resize(, lc + 1) = "=SUM(R2C:R" & m + 1 & "C)"
        For i = 3 To lc + 1 Step 2
            .Cells(2, i + 1).Resize(m + 1) = "=RC" & i & "/RC2*100"
            v = v + 1
            .Cells(1, i) = "出现" & Application.Text(v, "[DBNum1]") & "次"
            .Cells(1, i + 1) = "占比"
        Next
        .[a1].CurrentRegion.Borders.LineStyle = 1
    End With
End Sub

附件四——根据姓名统计出编号出现的记录条数(字典嵌套和用两个字典分别实现).rar (14.04 KB, 下载次数: 1140)

评分

参与人数 2鲜花 +5 技术 +1 收起 理由
wpxxsyzx + 1 优秀作品
YZLSZAJ + 5 优秀作品
查看全部评分
TA的精华主题TA的得分主题
5
 楼主| 发表于 2013-11-30 04:20 | 只看该作者 |楼主
本帖最后由 zhaogang1960 于 2014-1-11 10:49 编辑

五、ComboBox控件四级联动,本题目目的在于测试两种代码的速度
字典嵌套代码如下:
Dim d As Object

Private Sub ComboBox1_Change()
    If ComboBox1.ListIndex = -1 Then Exit Sub
    ComboBox2.Clear
    ComboBox3.Clear
    ComboBox4.Clear
    ComboBox2.List = d(ComboBox1.Value).Keys
End Sub

Private Sub ComboBox2_Change()
    If ComboBox2.ListIndex = -1 Then Exit Sub
    ComboBox3.Clear
    ComboBox4.Clear
    ComboBox3.List = d(ComboBox1.Value)(ComboBox2.Value).Keys
End Sub

Private Sub ComboBox3_Change()
    If ComboBox3.ListIndex = -1 Then Exit Sub
    ComboBox4.Clear
    ComboBox4.List = d(ComboBox1.Value)(ComboBox2.Value)(ComboBox3.Value).Keys
End Sub

Private Sub CommandButton1_Click()
  Unload UserForm1
End Sub

Private Sub UserForm_Initialize()
    tt = Timer
    Dim i&, arr
    Set d = CreateObject("scripting.dictionary")
    arr = [a1].CurrentRegion
    For i = 2 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, 2)) Then Set d(arr(i, 1))(arr(i, 2)) = CreateObject("scripting.dictionary")        '二级字典嵌套
        If Not d(arr(i, 1))(arr(i, 2)).Exists(arr(i, 3)) Then Set d(arr(i, 1))(arr(i, 2))(arr(i, 3)) = CreateObject("scripting.dictionary")        '三级字典嵌套
        If Not d(arr(i, 1))(arr(i, 2))(arr(i, 3)).Exists((arr(i, 4))) Then Set d(arr(i, 1))(arr(i, 2))(arr(i, 3))(arr(i, 4)) = CreateObject("scripting.dictionary")        '四级字典嵌套
    Next
    ComboBox1.List = d.Keys
    MsgBox Timer - tt
End Sub

一个字典实现代码如下:
Dim d As Object

Private Sub ComboBox1_Change()
    If ComboBox1.ListIndex = -1 Then Exit Sub
    ComboBox2.Clear
    ComboBox3.Clear
    ComboBox4.Clear
    ComboBox2.List = Split(d(ComboBox1.Value), ",")
End Sub

Private Sub ComboBox2_Change()
    If ComboBox2.ListIndex = -1 Then Exit Sub
    ComboBox3.Clear
    ComboBox4.Clear
    ComboBox3.List = Split(d(ComboBox1.Value & vbTab & ComboBox2.Value), ",")
End Sub

Private Sub ComboBox3_Change()
    If ComboBox3.ListIndex = -1 Then Exit Sub
    ComboBox4.Clear
    ComboBox4.List = Split(d(ComboBox1.Value & vbTab & ComboBox2.Value & vbTab & ComboBox3.Value), ",")
End Sub

Private Sub CommandButton1_Click()
  Unload UserForm1
End Sub

Private Sub UserForm_Initialize()
    tt = Timer
    Dim nodex As Node
    Dim arr, i&
    Set d = CreateObject("scripting.dictionary")
    arr = Range("a2:d" & Cells(Rows.Count, 1).End(xlUp).Row)
    For i = 1 To UBound(arr)
        s = arr(i, 1)
        If Not d.Exists(s) Then
            d(s) = arr(i, 2)
        Else
            If InStr("," & d(s) & ",", "," & arr(i, 2) & ",") = 0 Then d(s) = d(s) & "," & arr(i, 2)
        End If
        s = s & vbTab & arr(i, 2)
        If Not d.Exists(s) Then
            d(s) = arr(i, 3)
        Else
            If InStr("," & d(s) & ",", "," & arr(i, 3) & ",") = 0 Then d(s) = d(s) & "," & arr(i, 3)
        End If
        s = s & vbTab & arr(i, 3)
        If Not d.Exists(s) Then
            d(s) = arr(i, 4)
        Else
            If InStr("," & d(s) & ",", "," & arr(i, 4) & ",") = 0 Then d(s) = d(s) & "," & arr(i, 4)
        End If
    Next
    ComboBox1.List = Filter(d.Keys, vbTab, False)
    MsgBox Timer - tt
End Sub

附件五——ComboBox控件四级联动.rar (17.89 KB, 下载次数: 1513)

本帖中使用了一些坛友的附件、代码,附件中都有原帖链接,在此向他们表示感谢。

评分

参与人数 2鲜花 +5 技术 +1 收起 理由
wpxxsyzx + 1 优秀作品
YZLSZAJ + 5 优秀作品
查看全部评分
TA的精华主题TA的得分主题
6
发表于 2013-11-30 07:05 | 只看该作者
谢谢赵老师!赵老师也研究TreeView控件了呀,真是太好了!

点评

TreeView控件是原程序中的,我只是照抄,哈哈  发表于 2013-11-30 11:54
TA的精华主题TA的得分主题
7
发表于 2013-11-30 08:55 | 只看该作者
TA的精华主题TA的得分主题
8
发表于 2013-11-30 18:43 | 只看该作者
TA的精华主题TA的得分主题
9
发表于 2013-12-1 18:51 | 只看该作者
TA的精华主题TA的得分主题
10
发表于 2013-12-1 19:28 | 只看该作者
您需要登录后才可以回帖 登录 | 免费注册 新浪微博登陆
本版积分规则
关闭

最新热点上一条 /1 下一条

关注官方微信,每天坐享新鲜教程
手机版|关于我们|联系我们|ExcelHome    GMT+8, 2017-10-22 21:32 , Processed in 1.141641 second(s), 38 queries , Gzip On.
Powered by Discuz! X3.3 © 2001-2017 Wooffice Inc.
    沪公网安备 31011702000001号 沪ICP备11019229号 本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师
快速回复 返回顶部 返回列表
99uu优优