设为首页收藏本站|繁體中文

Excel 技巧网

 找回密码
 注册

QQ登录

只需一步,快速开始

手机号码,快捷登录

查看: 6528|回复: 22

[Excel VBA] 字典使用笔记

[复制链接]
发表于 2010-9-29 10:38:02 | 显示全部楼层 |阅读模式
  • 署名作者: liuguansky
  • 版权声明: 版权归本站与作者共有 除本站官方外非作者本人严禁转载
  • 本文来自:
  • 引用作品:
  • 适用版本: 2010 2007 2003以前版本 
  • 语言环境: 简体中文
  • 学习方法: 掌握Excel技巧的关键是动手操作 | 下载 ≠ 知识


  • 免费注册成为本站会员,享用更多功能,结识更多Office办公高手!

    您需要 登录 才可以下载或查看,没有帐号?注册

    x
    本帖最后由 liuguansky 于 2010-9-29 11:05 编辑
    以下实例算是本人近几日对字典学习的一个总结,如有不足之处,请不吝指点。另希望能对想学字典的人有所帮助。

    字典笔记.rar (63.44 KB, 下载次数: 249)

    评分

    参与人数 4魅力值 +20 收起 理由
    Zaezhong + 5 字典好的教材不多,这个不错
    小叶子 + 5 学习了
    JLxiangwei + 5 很棒
    wise + 5 不错,还有么?

    查看全部评分

     楼主| 发表于 2010-9-29 10:58:25 | 显示全部楼层
    本帖最后由 liuguansky 于 2010-9-29 11:02 编辑

    第四步,返回编号小于40,数量总计大于10000的汇总结果。代码如下
    1. Sub test4() '数量大于10000,且编号小于40的记录汇总
    2. Dim dic As Object, i&, j&, arr
    3. Set dic = CreateObject("scripting.dictionary")
    4. For i = 2 To Cells(Rows.Count, 1).End(3).Row
    5. If dic.exists(Cells(i, 1).Value) Then dic(Cells(i, 1).Value) = dic(Cells(i, 1).Value) + Cells(i, 2).Value Else: dic(Cells(i, 1).Value) = Cells(i, 2).Value
    6. Next i
    7. ' 先返回各编号数量汇总
    8. arr = dic.keys
    9. For j = 0 To dic.Count - 1
    10. If arr(j) >= 40 Or dic(arr(j)) <= 10000 Then dic.Remove arr(j)
    11. Next j
    12. '再进行条件判断,把不符记录REMOVE,剩余即为所求记录
    13. Range("K:N").Clear
    14. Cells(1, 11).Resize(1, 2) = Array("编号", "数量")
    15. If dic.Count > 0 Then
    16. Cells(2, 11).Resize(dic.Count, 1) = Application.Transpose(dic.keys)
    17. Cells(2, 12).Resize(dic.Count, 1) = Application.Transpose(dic.items)
    18. End If
    19. Set dic = Nothing
    20. End Sub
    复制代码
    先进行各编号的数量汇总,再进行条件判断,REMOVE不符合条件的KEY

    第五步:编号大于30小于70且数量大于15000,小于45000的汇总结果和记录个数,代码如下:
    1. Sub test5() '编号大于30小于70且数量大于15000,小于45000的记录
    2. Dim dic, i&, j&, m&, arr, arr1
    3. Set dic = CreateObject("scripting.dictionary")
    4. For i = 2 To Cells(Rows.Count, 1).End(3).Row
    5. If dic.exists(Cells(i, 1).Value) Then
    6. dic(Cells(i, 1).Value) = Split(dic(Cells(i, 1).Value), vbTab)(0) + Cells(i, 2).Value & vbTab & Split(dic(Cells(i, 1).Value), vbTab)(1) + 1
    7. Else: dic(Cells(i, 1).Value) = Cells(i, 2).Value & vbTab & 1
    8. End If
    9. Next i
    10. Rem ITEM构造
    11. '在之前基础上,多统计个数,此时构造ITEM时,可以把两个需统计记录用分隔符隔开,EXISTS累加的时,先用SPLIT取两段再累加。
    12. arr = dic.keys
    13. For j = 0 To dic.Count - 1
    14. If Not (arr(j) > 30 And arr(j) < 70 And Split(dic(arr(j)), vbTab)(0) < 45000 And Split(dic(arr(j)), vbTab)(0) > 15000) Then dic.Remove arr(j)
    15. Next j
    16. '再进行条件判断,把不符记录REMOVE,剩余即为所求记录
    17. Range("O:R").Clear
    18. arr1 = dic.items
    19. Cells(1, 14).Resize(1, 3) = Array("编号", "数量", "个数")
    20. If dic.Count > 0 Then
    21. '防止未有符合条件记录,返回错误。
    22. Cells(2, 14).Resize(dic.Count, 1) = Application.Transpose(dic.keys)
    23. For m = 0 To dic.Count - 1
    24. Cells(2 + m, 15).Resize(1, 2) = Application.Transpose(Application.Transpose((Split(arr1(m), vbTab))))
    25. Next m
    26. '转置两次,返回数值结果。
    27. End If
    28. Set dic = Nothing
    29. End Sub
    复制代码

    难点:
    1.对ITEM多个返回值和构造:<相同编号,其他文本项目连接,数字项目累加>
       
    if  dic.exists(a) then split(dic(a),分隔符)(数组标志) & A & 分隔符 split(dic(a),分隔符)(数组标志) & B & 分隔符....

           [quote][上式中如果是文本连接用&,如果是数值相加就用+][/quote]

    2.求差集
         
    可以先赋值一个字典,再判断字典元素,用REMOVE去除不满足KEY。


    3.如果是差集,或其他返回满足条件记录,为防止DIC.COUNT为0,对返回值处理出错,就对DIC.COUNT进行判断

    4.返回值如果是经SPLIT处理的。建议用两次Application.Transpose防止返回数据类型出错
    第六步:返回数量大于编号*50,小于编号*200的汇总结果
    1. Sub test6() '数量大于编号*50,小于编号*200的记录
    2. Dim dic, i&, j&, m&, arr, arr1
    3. Set dic = CreateObject("scripting.dictionary")
    4. For i = 2 To Cells(Rows.Count, 1).End(3).Row
    5. If dic.exists(Cells(i, 1).Value) Then
    6. dic(Cells(i, 1).Value) = Split(dic(Cells(i, 1).Value), vbTab)(0) + Cells(i, 2).Value & vbTab & Split(dic(Cells(i, 1).Value), vbTab)(1) + 1
    7. Else: dic(Cells(i, 1).Value) = Cells(i, 2).Value & vbTab & 1
    8. End If
    9. Next i
    10. arr = dic.keys
    11. For j = 0 To dic.Count - 1
    12. If Val(Split(dic(arr(j)), vbTab)(0)) <= arr(j) * 50 Or Val(Split(dic(arr(j)), vbTab)(0)) >= arr(j) * 200 Then dic.Remove arr(j)
    13. Next j
    14. '条件判断,可以KEY与ITEM进行比较
    15. Range("S:V").Clear
    16. arr1 = dic.items
    17. Cells(1, 18).Resize(1, 3) = Array("编号", "数量", "个数")
    18. If dic.Count > 0 Then
    19. Cells(2, 18).Resize(dic.Count, 1) = Application.Transpose(dic.keys)
    20. For m = 0 To dic.Count - 1
    21. Cells(2 + m, 19).Resize(1, 2) = Application.Transpose(Application.Transpose((Split(arr1(m), vbTab))))
    22. Next m
    23. End If
    24. Set dic = Nothing
    25. End Sub
    复制代码

    KEY与ITEM的比较

    第七步,返回单行记录满足编号大于25,数量大于2500的编号与数量汇总结果及记录个数。代码如下:

    1. Sub test7() '判断单行记录是否满足编号大于25,数量大于2500,返回满足条件的编号与数量汇总清单
    2.   Dim dic, i&, j&, m&, arr, arr1
    3.   Set dic = CreateObject("scripting.dictionary")
    4.   For i = 2 To Cells(Rows.Count, 1).End(3).Row
    5.     If Val(Cells(i, 1).Value) > 25 And Cells(i, 2).Value > 2500 Then
    6.       If dic.exists(Cells(i, 1).Value) Then
    7.           dic(Cells(i, 1).Value) = Split(dic(Cells(i, 1).Value), vbTab)(0) + Cells(i, 2).Value & vbTab & Split(dic(Cells(i, 1).Value), vbTab)(1) + 1
    8.         Else: dic(Cells(i, 1).Value) = Cells(i, 2).Value & vbTab & 1
    9.       End If
    10.     End If
    11.   Next i
    12.   Rem 判断记录后再进行字典处理
    13.     Range("w:z").Clear
    14.     arr1 = dic.items
    15.     Cells(1, 22).Resize(1, 3) = Array("编号", "数量", "个数")
    16.     If dic.Count > 0 Then
    17.     '防止未有符合条件记录,返回错误。
    18.     Cells(2, 22).Resize(dic.Count, 1) = Application.Transpose(dic.keys)
    19.     For m = 0 To dic.Count - 1
    20.       Cells(2 + m, 23).Resize(1, 2) = Application.Transpose(Application.Transpose((Split(arr1(m), vbTab))))
    21.     Next m
    22.     '转置两次,返回数值结果。
    23.     End If
    24.     Set dic = Nothing
    25. End Sub
    复制代码

    与第六步相比,主要是在判断的位置出现差异。


    评分

    参与人数 1魅力值 +5 收起 理由
    zm0115 + 5 我要好好抄抄你的笔记

    查看全部评分

    回复 支持 反对

    使用道具 举报

    发表于 2010-10-26 23:12:01 | 显示全部楼层
    前4题 SQL的写法
    1. select  DISTINCT 编号 from [Sheet1$A:B]
    复制代码
    1. select 编号,count(编号) as 个数 from [Sheet1$A:B] group by 编号
    复制代码
    1. select 编号,sum(数量) as 数量 from [Sheet1$A:B] group by 编号
    复制代码
    1. select  * from (select 编号,sum(数量) as 数量 from  [Sheet1$A:B] group by 编号) where 编号<40 and 数量 >10000
    复制代码

    评分

    参与人数 3魅力值 +15 收起 理由
    bensonlei + 5 技术创新:)
    lisan + 5 学习了。
    ljh29206 + 5 - -!! sql 这么简单就能达到效果!

    查看全部评分

    回复 支持 反对

    使用道具 举报

    发表于 2010-12-20 21:47:49 | 显示全部楼层
    帮gg 丁丁..明天好好来学习学习
    回复 支持 反对

    使用道具 举报

    发表于 2011-2-1 19:12:55 | 显示全部楼层
    字典看得太晕了,还是3楼wise版主的SQL好理解。谢谢!
    回复 支持 反对

    使用道具 举报

    发表于 2011-2-16 22:22:57 | 显示全部楼层
    在学习,正需要,谢了!
    回复 支持 反对

    使用道具 举报

    发表于 2011-2-17 09:46:49 | 显示全部楼层
    学习了,感觉有点难!
    回复 支持 反对

    使用道具 举报

    发表于 2011-3-27 11:58:59 | 显示全部楼层
    学习了,感觉太难了。
    回复 支持 反对

    使用道具 举报

    发表于 2011-3-29 14:10:52 | 显示全部楼层
    学习了,感觉不太清楚!再加强学习吧
    回复 支持 反对

    使用道具 举报

    发表于 2011-5-3 22:50:48 | 显示全部楼层
    后面三题,5,6,7的SQL写法。
    1. select 编号,sum(数量) as 数量,count(*) as 个数 from [sheet1$a1:b] where  编号 > 30 and 编号 < 70 group by 编号 having sum(数量) > 15000 and sum(数量) < 45000
    复制代码
    1. select 编号,sum(数量) as 数量,count(*) as 个数 from [sheet1$a1:b]  group by 编号 having sum(数量) > 编号*50 and sum(数量) < 编号*200
    复制代码
    1. select 编号,sum(数量) as 数量,count(*) as 个数 from [sheet1$a1:b] where 编号 > 25 and 数量>2500 group by 编号
    复制代码
    回复 支持 反对

    使用道具 举报

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

    本版积分规则

    关闭

    站长推荐上一条 /1 下一条

    Excel技巧网的会员探讨问题仅代表其个人意见,与网站的立场无关。任何违反国家和地方相关法律法规的言论,本站有义务协助政府相关部门追究发言者的责任!
    本站中非注明转载文章与案例的版权为作者与Excel技巧网共有。若非原文作者,本站之外任何单位或个人未经允许,不得将其用于商业用途。
    若非原文作者,任何形式的非商业性转载必须获得Excel技巧网或作者允许,并注明作者和出处。
    会员发表的帖子如涉及版权纠纷,须自行负责。详情请参考注册时的网站服务条款。
    本站特聘法律顾问:沈学律师

    Archiver|手机版|Excel技巧网 ( 闽ICP备08107682号-2 ) | 闽公网安备 35020302032608号  

    GMT+8, 2018-1-20 10:47

    Powered by Discuz! X3.3

    © 2001-2017 Comsenz Inc.

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