改进的Union函数（微信文章未删减版）

正文

学习Excel技术，关注微信公众号：

excelperfect

标签：VBA

VBA的Union方法将两个单元格区域合并成单个单元格区域，例如：

Dim rng As RangeSet rng = Application.Union(Range("A1:A5"), Range("B1:B5"))

将单元格区域A1:A5和B1:B5合并成单个的单元格区域rng，其代表区域A1:B5。

然而，Union方法有两个缺点：

1.其输入参数不能是Nothing。如果任意参数为Nothing，则Union操作失败。

2.当输入参数指定的区域重叠时，它会复制单元格。这可能会导致代码中的逻辑问题，因为重叠的单元格在Union结果中包含了两次。

下面改进的Union函数允许传递的参数值为Nothing。

'Union操作接受参数为NothingFunction Union1(ParamArray Ranges() As Variant) As Range Dim lng As Long Dim rng As Range For lng = LBound(Ranges) To UBound(Ranges)   If IsObject(Ranges(lng)) Then     If Not Ranges(lng) Is Nothing Then       If TypeOf Ranges(lng) Is Excel.Range Then         If Not rng Is Nothing Then           Set rng = Application.Union(rng, Ranges(lng))         Else           Set rng = Ranges(lng)         End If       End If     End If   End If Next lng Set Union1 = rngEnd Function

下面改进的Union函数处理合并时的重叠区域单元格。

' 当单元格区域有重叠时' 不会复制重叠区域的单元格' 需要使用Union1函数Function ProperUnion(ParamArray Ranges() As Variant) As Range Dim rngRes As Range Dim lng As Long Dim rng As Range
 If Not Ranges(LBound(Ranges)) Is Nothing Then   Set rngRes = Ranges(LBound(Ranges)) End If For lng = LBound(Ranges) + 1 To UBound(Ranges)   If Not Ranges(lng) Is Nothing Then     For Each rng In Ranges(lng).Cells       If Application.Intersect(rngRes, rng) Is Nothing Then         Set rngRes = Union1(rngRes, rng)       End If     Next rng   End If Next lng Set ProperUnion = rngResEnd Function