如何用VBA求出两个不连续区域的差集

作者：绿色风分类：时间：2022-08-17 浏览：175

楼主芐雨	Q:如何用VBA求出两个不连续区域的差集 A:可以用循环把两个区域的地址找出来，再合并区域昨天发了一贴，讲解了集合的差集，交集，并集，不明白这些概念可以再看下面的链接如何用VBA求出两个区域的差集，交集，并集 (出处: Excel 技巧网) 上次的代码只限于两个连续的区域，这次换了另一种思路，可以求出两个不连续的区域的差集。 Sub 两个不连续区域的差集_芐雨() Dim d Dim A As Range, B As Range, rng As Range, Arg As Range, arr As Range Dim x As Integer Set d = CreateObject("scripting.dictionary") On Error Resume Next ActiveSheet.Cells.Clear Set A = Application.InputBox("请选择区域，按住ctrl可选择多个不连续的区域", Type:=8) '选定集合A，填充颜色 A.Interior.ColorIndex = 38 Set B = Application.InputBox("请选择区域，按住ctrl可选择多个不连续的区域", Type:=8) '选定集合B，填充颜色 B.Interior.ColorIndex = 45 Set Arg = Application.Intersect(A, B) 'A与B的交集Arg For Each rng In Arg '循环交集Arg的单元格 d.Add rng.Address, "" '把每个单元格的地址放入字典D中 Next For Each rng In A '循环集合A的单元格 If Not d.exists(rng.Address) Then '集合A的地址不存在于字典D中，执行下面 If arr Is Nothing Then Set arr = rng '防止arr为空时，union出错 Set arr = Union(arr, rng) '合并集合（区域） End If Next If arr Is Nothing Then 'arr为空,无差集 MsgBox "无差集" Else arr.Borders.ColorIndex = 1 '加上边框 MsgBox arr.Address End If End Sub
2楼海洋之星	谢谢分享，请规范帖子以便移到相关技术文章区
3楼水星钓鱼	感谢分享

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，经与ExcelTip.Net站长Apolloh商议并征得其同意，现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，供有需要的人士查询使用，也慰缅曾经的论坛时代。所示各个帖子的原作者如对版权有异议，可与本人沟通提出，或于本站点留言，我们会尽快处理。在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表

楼主芐雨	Q:如何用VBA求出两个不连续区域的差集 A:可以用循环把两个区域的地址找出来，再合并区域昨天发了一贴，讲解了集合的差集，交集，并集，不明白这些概念可以再看下面的链接如何用VBA求出两个区域的差集，交集，并集 (出处: Excel 技巧网) 上次的代码只限于两个连续的区域，这次换了另一种思路，可以求出两个不连续的区域的差集。 Sub 两个不连续区域的差集_芐雨() Dim d Dim A As Range, B As Range, rng As Range, Arg As Range, arr As Range Dim x As Integer Set d = CreateObject("scripting.dictionary") On Error Resume Next ActiveSheet.Cells.Clear Set A = Application.InputBox("请选择区域，按住ctrl可选择多个不连续的区域", Type:=8) '选定集合A，填充颜色 A.Interior.ColorIndex = 38 Set B = Application.InputBox("请选择区域，按住ctrl可选择多个不连续的区域", Type:=8) '选定集合B，填充颜色 B.Interior.ColorIndex = 45 Set Arg = Application.Intersect(A, B) 'A与B的交集Arg For Each rng In Arg '循环交集Arg的单元格 d.Add rng.Address, "" '把每个单元格的地址放入字典D中 Next For Each rng In A '循环集合A的单元格 If Not d.exists(rng.Address) Then '集合A的地址不存在于字典D中，执行下面 If arr Is Nothing Then Set arr = rng '防止arr为空时，union出错 Set arr = Union(arr, rng) '合并集合（区域） End If Next If arr Is Nothing Then 'arr为空,无差集 MsgBox "无差集" Else arr.Borders.ColorIndex = 1 '加上边框 MsgBox arr.Address End If End Sub
2楼海洋之星	谢谢分享，请规范帖子以便移到相关技术文章区
3楼水星钓鱼	感谢分享