ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 EH云课堂直播课程免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 17058|回复: 94

[原创] 曾经的回帖整理-字典案例部分

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2017-12-17 19:28 | 显示全部楼层 |阅读模式
本帖最后由 liulang0808 于 2018-11-30 21:22 编辑

今天发现自己的积分超过20000了,就回忆下曾经的回帖情况。
针对字典部分重新整理了几个示例,处理法方法不一定是最优的,供参考
注意:示例中使用了数组,在实际应用中要注意数组对应的数据起止位置,避免有出入。另外在使用字典的时候,以rang对象最为key是要出问题的
比如字典变量d,d(cells(1,1))=""是会遇到问题的,要使用d(cells(1,1).value)=""

此贴留作目录
一、以A列姓名为关键字,保存最上面一条数据,删除下面的重复部分http://club.excelhome.net/forum.php?mod=redirect&goto=findpost&ptid=1385473&pid=9342512

二、根据A列姓名,统计各个姓名对应的数量汇总,统计次数雷同
类似于分类汇总的功能http://club.excelhome.net/forum. ... 1385473&pid=9342517


三、以A,B两列为关键字,统计数量汇总
1、使用字典直接以两列为关键字,进行累加
http://club.excelhome.net/forum. ... 1385473&pid=9342520


2、使用字典保存对应的行,然后对数组内数据累加
http://club.excelhome.net/forum. ... 1385473&pid=9342523

四、将数据转置处理
1、使用三个字典变量
http://club.excelhome.net/forum. ... 1385473&pid=9342538
另外一个求和实例
http://club.excelhome.net/forum. ... 1385473&pid=9364215
2、字典结合单元格处理,需要A,B列关键互相没有重名
http://club.excelhome.net/forum. ... 1385473&pid=9342540

五、根据A列姓名,将数据拆分到各张表内,如果表不存在,就创建新表
http://club.excelhome.net/forum. ... 1385473&pid=9342542


六、生成1到100之间不重复的十个整数
http://club.excelhome.net/forum. ... 1385473&pid=9342545


七、对某个区域的数据,进行随机排序
http://club.excelhome.net/forum. ... 1385473&pid=9342547


八、中国式排名(使用了字典,供参考)
http://club.excelhome.net/thread-1170523-1-1.html

九、二级菜单级联,使用表格事件+字典实现
http://club.excelhome.net/forum. ... 1385473&pid=9342777

十、字典+递归进行凑数
http://club.excelhome.net/thread-1385584-1-1.html回复其他人的帖子
http://club.excelhome.net/forum. ... 1388541&pid=9356555
另外一个提取N个组合的问题
http://club.excelhome.net/forum. ... 1385473&pid=9361666

也是凑数的回帖http://club.excelhome.net/forum. ... 1396706&pid=9411696

本帖跟帖代码43楼
http://club.excelhome.net/forum. ... 1385473&pid=9411699


十一、使用递归+字典求最短路径
http://club.excelhome.net/forum. ... 1385473&pid=9346547
此贴是蓝板出的题目:地址链接:
[第119期]假如你是无人驾驶车上的电脑,你想好了怎么走吗?
http://club.excelhome.net/thread-1379620-1-1.html
(出处: ExcelHome技术论坛)
截止日期是12月20日


十二、其他涉及字典应用的回帖汇总,供参考:
1、http://club.excelhome.net/forum. ... 1386033&pid=9346561
2、http://club.excelhome.net/forum. ... 1386121&pid=9346545
3、字典+GOTO语句,与递归雷同,进行穷举http://club.excelhome.net/forum. ... 1385473&pid=9354367
原帖见链接:http://club.excelhome.net/forum. ... 1388179&pid=9354350
4、划分数字的问题http://club.excelhome.net/forum. ... 1385473&pid=9356625
5、字典+fso对多个工作薄文件数据进行汇总
http://club.excelhome.net/forum. ... 1385473&pid=9358280
原帖出处:http://club.excelhome.net/forum. ... 1388796&pid=9358274
原帖是统计上下班时间,并进行颜色标示
http://club.excelhome.net/forum. ... 1391996&pid=9379607
根据名称拆分到多表,然后再将多表分组创建文件,并保存在指定文件夹下
原帖位置:
http://club.excelhome.net/forum. ... 1421599&pid=9564841
三级下来菜单回帖
http://club.excelhome.net/forum. ... 900&pid=9741611







评分

参与人数 22财富 +20 鲜花 +44 收起 理由
幻砾 + 1 太强大了
huangkepan + 2 优秀作品
凤翔时代 + 2 太强大了
WYS67 + 3 太强大了
aecn + 2 太强大了

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-12-17 19:30 | 显示全部楼层
  1. Sub 按钮1_Click()
  2.     Set d = CreateObject("scripting.dictionary")
  3.     Set Rng = Nothing
  4.     arr = [a1].CurrentRegion
  5.     Application.ScreenUpdating = False
  6.     For j = 1 To UBound(arr)
  7.         If d.exists(arr(j, 1)) Then
  8.             If Rng Is Nothing Then
  9.                 Set Rng = Cells(j, 1)
  10.             Else
  11.                 Set Rng = Union(Rng, Cells(j, 1))
  12.             End If
  13.         Else
  14.             d(arr(j, 1)) = ""
  15.         End If
  16.     Next j
  17.     If Not Rng Is Nothing Then Rng.EntireRow.Delete
  18.     Application.ScreenUpdating = True
  19. End Sub
复制代码


根据A列内容,保存表格内数据最上面一行,删除下面的重复行

字典实例-01.zip

15.48 KB, 下载次数: 526

评分

参与人数 2鲜花 +5 收起 理由
凤翔时代 + 2 优秀作品
达州张先生 + 3 值得肯定

查看全部评分

TA的精华主题

TA的得分主题

发表于 2017-12-17 19:30 | 显示全部楼层
留个沙发,呵呵
说明版主帮人无数,予人玫瑰,手有余香。感谢!感谢!
祝愿论坛越来越好!

点评

没有主题贴,都是来帮人解决问题的。佩服  发表于 2017-12-17 20:14

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-12-17 19:32 | 显示全部楼层
  1. Sub 按钮1_Click()
  2.     Set d = CreateObject("scripting.dictionary")
  3.     arr = Sheets("原始数据").[a1].CurrentRegion
  4.     Application.ScreenUpdating = False
  5.     ActiveSheet.UsedRange.ClearContents
  6.     For j = 2 To UBound(arr)
  7.         d(arr(j, 1)) = d(arr(j, 1)) + arr(j, 3)
  8.     Next j
  9.     [a1:b1] = Array("客户姓名", "消费总量")
  10.     If d.Count > 0 Then
  11.         [a2].Resize(d.Count) = WorksheetFunction.Transpose(d.keys)
  12.         [b2].Resize(d.Count) = WorksheetFunction.Transpose(d.items)
  13.     End If
  14.     Application.ScreenUpdating = True
  15. End Sub
复制代码


根据A列姓名,统计各个姓名对应的数量汇总
类似于分类汇总的功能

字典实例-02.zip

16.3 KB, 下载次数: 637

评分

参与人数 1鲜花 +3 收起 理由
达州张先生 + 3 值得肯定

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-12-17 19:34 | 显示全部楼层
  1. Sub 按钮1_Click()
  2.     Set d = CreateObject("scripting.dictionary")
  3.     arr = Sheets("原始数据").[a1].CurrentRegion
  4.     Application.ScreenUpdating = False
  5.     ActiveSheet.UsedRange.ClearContents
  6.     For j = 2 To UBound(arr)
  7.         d(arr(j, 1) & "#" & arr(j, 2)) = d(arr(j, 1) & "#" & arr(j, 2)) + arr(j, 3)
  8.     Next j
  9.    
  10.     If d.Count > 0 Then
  11.         [a2].Resize(d.Count) = WorksheetFunction.Transpose(d.keys)
  12.         [c2].Resize(d.Count) = WorksheetFunction.Transpose(d.items)
  13.     End If
  14.     Columns("A:A").TextToColumns Destination:=Range("A1"), OtherChar:="#"
  15.     [a1:c1].Value = Sheets("原始数据").[a1:c1].Value
  16.     Application.ScreenUpdating = True
  17. End Sub
复制代码

以A,B列数据为关键字,统计数量汇总
使用字典直接以两列为关键字,进行累加

评分

参与人数 3鲜花 +7 收起 理由
YZC51 + 3
sdg1345 + 1 优秀作品
达州张先生 + 3 值得肯定

查看全部评分

TA的精华主题

TA的得分主题

发表于 2017-12-17 19:34 | 显示全部楼层
liulang0808 发表于 2017-12-17 19:30
根据A列内容,保存表格内数据最上面一行,删除下面的重复行

你这代码里刚好有个数组,问下关于数组的定义,如果我用循环的方式获取了一部分数据,我该如何用数组的方式来定义表达。。比如,循环获取网页的数据得到如下:
100
101
102
103
104
105

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-12-17 19:35 | 显示全部楼层
  1. Sub 按钮2_Click()
  2.     Set d = CreateObject("scripting.dictionary")
  3.     arr = Sheets("原始数据").[a1].CurrentRegion
  4.     Application.ScreenUpdating = False
  5.     ActiveSheet.UsedRange.ClearContents
  6.     a = 2
  7.     For j = 2 To UBound(arr)
  8.         If d.exists(arr(j, 1) & "#" & arr(j, 2)) Then
  9.             arr(d(arr(j, 1) & "#" & arr(j, 2)), 3) = arr(j, 3) + arr(d(arr(j, 1) & "#" & arr(j, 2)), 3)
  10.         Else
  11.             For i = 1 To UBound(arr, 2)
  12.                 arr(a, i) = arr(j, i)
  13.             Next i
  14.             
  15.             d(arr(j, 1) & "#" & arr(j, 2)) = a
  16.             a = a + 1
  17.         End If
  18.     Next j
  19.     [a1].Resize(a - 1, UBound(arr, 2)) = arr
  20.     Application.ScreenUpdating = True
  21. End Sub
复制代码

以A,B两列为关键字,统计数量汇总,不同于楼上的方法
使用字典保存对应的行,然后对数组内数据累加

字典实例-03.zip

19.3 KB, 下载次数: 542

评分

参与人数 1鲜花 +3 收起 理由
达州张先生 + 3 值得肯定

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-12-17 19:38 | 显示全部楼层
kings12333 发表于 2017-12-17 19:34
你这代码里刚好有个数组,问下关于数组的定义,如果我用循环的方式获取了一部分数据,我该如何用数组的方 ...

楼主的需求看看是否可以使用动态数组,另外建议楼主自己发个求助帖看看

评分

参与人数 1鲜花 +3 收起 理由
达州张先生 + 3 感谢帮助

查看全部评分

TA的精华主题

TA的得分主题

发表于 2017-12-17 19:39 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-12-17 19:48 | 显示全部楼层
  1. Sub 按钮1_Click()
  2.     Set d = CreateObject("scripting.dictionary")
  3.     Set dnm = CreateObject("scripting.dictionary")
  4.     Set dy = CreateObject("scripting.dictionary")
  5.     arr = Sheets("原始数据").[a1].CurrentRegion
  6.     Application.ScreenUpdating = False
  7.     ActiveSheet.UsedRange.ClearContents
  8.     For j = 2 To UBound(arr)
  9.         d(arr(j, 1) & "#" & arr(j, 2)) = d(arr(j, 1) & "#" & arr(j, 2)) + arr(j, 3)
  10.         dnm(arr(j, 1)) = ""
  11.         dy(arr(j, 2)) = ""
  12.     Next j
  13.    
  14.     [a2].Resize(dnm.Count) = WorksheetFunction.Transpose(dnm.keys)
  15.     [b1].Resize(1, dy.Count) = dy.keys
  16.     [a1] = "客户姓名"
  17.     arr = [a1].CurrentRegion
  18.     For j = 2 To UBound(arr)
  19.         For i = 2 To UBound(arr, 2)
  20.             arr(j, i) = d(arr(j, 1) & "#" & arr(1, i))
  21.         Next i
  22.     Next j
  23.     [a1].CurrentRegion = arr
  24.     Application.ScreenUpdating = True
  25. End Sub
  26. 将数据转置存储,使用三个字典变量,附件见楼下
复制代码

评分

参与人数 2鲜花 +4 收起 理由
57403080 + 2 感谢帮助
ynymzzr + 2

查看全部评分

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

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

关注官方微信,每天学会一个新技能

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

GMT+8, 2019-12-11 00:10 , Processed in 0.374761 second(s), 18 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

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

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

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