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

Excel 技巧网

 找回密码
 注册

QQ登录

只需一步,快速开始

手机号码,快捷登录

查看: 4481|回复: 4

[Excel VBA] 如何利用VBA字典合并单元格同类项

[复制链接]
发表于 2014-6-15 20:17:25 | 显示全部楼层 |阅读模式
  • 署名作者: 芐雨
  • 版权声明: 版权归本站与作者共有 除本站官方外非作者本人转载须经许可并注明出处
  • 本文来自:
  • 引用作品:
  • 适用版本: 2013 2010 2007 
  • 语言环境: 简体中文
  • 学习方法: 掌握Excel技巧的关键是动手操作 | 下载 ≠ 知识


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

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

    x
    本帖最后由 芐雨 于 2014-6-15 20:17 编辑

    Q:如何利用VBA字典合并单元格同类项
    A:
    QQ图片20140615193523.jpg

    上面列举了合并的三种规则:
    1.单元格上下左右相邻的值相等就合并,顺序先行后列----代码09行
    2.单元格上下相邻的值相等合并(列方向)----代码10行
    3.单元格左右相邻的值相等合并(行方向)----代码11行

    PS:比较常用的是列方向和行方向的合并,大家可以根据图和代码来对比三种规则的不同之处

    代码如下:
    1. Sub 利用字典合并同类项_芐雨()
    2.     Dim rng As Range, rg As Range, d As Object
    3.     Application.ScreenUpdating = False
    4.     Application.DisplayAlerts = False
    5.     Range("A11:E17").Copy Range("A1:E7")
    6.     Set rng = Range("A1:E7")
    7.     Set d = CreateObject("scripting.dictionary")
    8.     For Each rg In rng
    9.         s = rg.Value               '等于单元格rg的值
    10.         ' s = rg.Value & "#" & rg.Column    '等于单元格rg的值&"#"&rg的列号
    11.         ' s = rg.Value & "#" & rg.Row  '等于单元格rg的值&"#"&rg的行号
    12.         If d.exists(s) Then    '存在执行连接单元格对象
    13.             Set d(s) = Union(d(s), rg)
    14.         Else
    15.             Set d(s) = rg    '不存在等于单元格对象
    16.         End If
    17.     Next
    18.     For Each ky In d.keys   '遍历所有字典并合并单元格
    19.         d(ky).Merge
    20.     Next
    21.     rng.Borders.LineStyle = 1   '边框
    22.     rng.HorizontalAlignment = xlCenter    '左右居中对齐
    23.     rng.VerticalAlignment = xlCenter     '上下居中对齐
    24.     Application.ScreenUpdating = True
    25.     Application.DisplayAlerts = True
    26. End Sub
    复制代码


    重要代码详解:
    1、字典可以是一个值,也可以是对象。rg表示一个单元格
    给普通变量赋值,可以直接等于:d(s)=rg,等于Range的值
    给对象变量赋值使用SET,  Set d(s) = rg ,也就是说d(s)是一个Range。   

         
    2、利用字典的去重功能,把重复的数值的单元格对象利用Union合并在一起
    如果要单元格上下左右相邻的值相等就合并,s = rg.Value,等于单元格rg的值,
    如果只需列或行方向相邻的值相等才合并,加个列号或行号就以区分就可以了,详细见代码10,11行。
    1.           s = rg.Value               '等于单元格rg的值
    2.         ' s = rg.Value & "#" & rg.Column    '等于单元格rg的值&"#"&rg的列号
    3.         ' s = rg.Value & "#" & rg.Row  '等于单元格rg的值&"#"&rg的行号
    4.         If d.exists(s) Then    '存在执行连接单元格对象
    5.             Set d(s) = Union(d(s), rg)
    6.         Else
    7.             Set d(s) = rg    '不存在等于单元格对象
    8.         End If
    复制代码

    3、遍历所有字典并合并单元格,利用key值遍历所有字典。
    其中d(ky)可以是一个单元格对象,也可以由多个单元格或单元格区域组成的区域,直接用Merge合并单元格(效果等同于用Ctrl选取多个单元格区域,再按合并单元。)

    1. For Each ky In d.keys   '遍历所有字典并合并单元格
    2.         d(ky).Merge
    3. Next
    复制代码


    附件:
    利用字典合并同类项_芐雨.zip (15.6 KB, 下载次数: 32)

    评分

    参与人数 1魅力值 +5 收起 理由
    贝式弧线 + 5 多谢分享

    查看全部评分

    发表于 2016-4-14 15:34:58 | 显示全部楼层
    好神奇的有法,太感谢了
    回复 支持 反对

    使用道具 举报

    发表于 2016-5-6 08:37:57 | 显示全部楼层
    初学者···学习了················
    回复 支持 反对

    使用道具 举报

    发表于 2018-3-7 09:18:28 | 显示全部楼层
    谢谢了收藏起来!
    回复 支持 反对

    使用道具 举报

    发表于 2018-5-14 06:04:14 | 显示全部楼层
    非常感谢,收藏了!
    回复 支持 反对

    使用道具 举报

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

    本版积分规则

    关闭

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

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

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

    GMT+8, 2018-8-22 03:22

    Powered by Discuz! X3.3

    © 2001-2017 Comsenz Inc.

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