ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 38307|回复: 73

[分享] 字典四级嵌套,相信很多人没用过

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2013-11-28 08:20 | 显示全部楼层 |阅读模式
本帖已被收录到知识树中,索引项:数组集合和字典
本帖最后由 chxw68 于 2013-11-28 08:53 编辑

此问题是网友GovanWAng提出来的,要求建立乡、村、组、村民四级目录树,试着用其他方法做比较烦琐,后来改用字典嵌套的方法,很好的解决了问题,发现程序层次清晰、结构严谨,希望能够抛砖引玉,对大家有所帮助。
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 = l + 1
          Set nodex = TreeView1.Nodes.Add(cc & k, tvwChild, dd & l, dd) '添加五级节点
        Next
      Next
    Next
  Next
End Sub

建立目录树.rar

20.37 KB, 下载次数: 2605

评分

22

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2013-11-28 08:49 | 显示全部楼层
本帖最后由 chxw68 于 2013-11-28 08:54 编辑

再提供一个两级字典嵌套的例子,很能说明字典嵌套用法的必要性,在个别情况下,使用字典能能够达到事半功倍的效果。
Sub test1()
  Dim d  As Object
  Dim i, j, r, c As Integer
  Set d = CreateObject("scripting.dictionary") '建立字典
  
  Worksheets("数据源").Select
  c = Range("a1").End(xlToRight).Column
  
  For j = 1 To c Step 2
    r = Cells(Rows.Count, j).End(xlUp).Row
    arr = Range(Cells(1, j), Cells(r, j + 1))
    If Not d.Exists(arr(1, 1)) Then
      Set d(arr(1, 1)) = CreateObject("scripting.dictionary") '建立二字典
    End If
    For i = 2 To UBound(arr)
      If Len(arr(i, 2)) <> 0 Then
        d(arr(1, 1))(arr(i, 1)) = d(arr(1, 1))(arr(i, 1)) + arr(i, 2) '给二级字典项目赋值
      End If
    Next
  Next
  
  Worksheets("结果").Select
  Cells.ClearContents
  
  For j = 0 To d.Count - 1
    Cells(1, j * 3 + 1) = d.Keys()(j) '将一级字典关键字写入行标题
    Cells(2, j * 3 + 1).Resize(d(d.Keys()(j)).Count, 1) = Application.Transpose(d(d.Keys()(j)).Keys) '将二级字典关键字写入数据表
    Cells(2, j * 3 + 2).Resize(d(d.Keys()(j)).Count, 1) = Application.Transpose(d(d.Keys()(j)).Items) '将二级字典项目写入数据表
    r = Cells(Rows.Count, j * 3 + 1).End(xlUp).Row + 1
    Cells(r, j * 3 + 1) = "合计"
    Cells(r, j * 3 + 2) = "=SUM(R[-" & r - 2 & "]C:R[-1]C)"
  Next
  Set d = Nothing
End Sub

材料数据分析.rar

9.66 KB, 下载次数: 1524

评分

4

查看全部评分

TA的精华主题

TA的得分主题

发表于 2013-11-28 10:05 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
"Micerosoft TreeView Conntrol,version6.0"控件。
请教:以上控件在代码中能实现“引用”吗?谢谢。

TA的精华主题

TA的得分主题

 楼主| 发表于 2013-11-28 10:21 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
好奇心 发表于 2013-11-28 10:05
"Micerosoft TreeView Conntrol,version6.0"控件。
请教:以上控件在代码中能实现“引用”吗?谢谢。

没见这样用过。

TA的精华主题

TA的得分主题

发表于 2013-11-28 10:32 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
很好,谢谢楼主。得好好学习。

TA的精华主题

TA的得分主题

发表于 2013-11-28 16:10 | 显示全部楼层
chxw68 发表于 2013-11-28 08:49
再提供一个两级字典嵌套的例子,很能说明字典嵌套用法的必要性,在个别情况下,使用字典能能够达到事半功倍 ...

2楼附件下载不了,请看楼下的截图。

TA的精华主题

TA的得分主题

发表于 2013-11-28 16:11 | 显示全部楼层
下载失败信息.rar (111.92 KB, 下载次数: 101)

TA的精华主题

TA的得分主题

 楼主| 发表于 2013-11-28 16:14 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
好奇心 发表于 2013-11-28 16:11

我试了一下,下载没问题。

TA的精华主题

TA的得分主题

发表于 2013-11-28 16:43 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2013-11-28 18:24 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
楼主继续琢磨怎么让嵌套的层数是动态的,1楼的代码就会短不少,适用性也能提高。

接下来,再考虑不用字典怎么实现同样的功能。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-15 01:51 , Processed in 0.040793 second(s), 12 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表