VBA实用小程序66： 改进的Union函数

excelperfect

本文学习整理自cpearson.com，改进了VBA内置的Union方法存在的小问题。

在编写VBA代码时，Union方法能够将多个单元格区域进行联合，让我们将它们当作一个单元区域来对待。例如代码：

Dim RR As RangeSet RR =Applicaiton.Union(Range('A1:A10'),Range('B1:B10'))

将单元格区域A1:A10和B1:B10合并成单个区域，运行代码后的RR代表引用区域A1:B10。

然而，Union方法存在两个问题。

1.不接受Nothing参数。如果传递给Union方法的参数值为Nothing，则会导致错误。例如代码：

Dim R1 As RangeDim R2 As RangeDim R3 As RangeDim RR As RangeSet R1 =Range('A1')Set R2 =Range('B1')Set RR =Application.Union(R1, R2, R3)

由于变量R3没有赋任何值，运行代码会触发错误：错误5-无效的参数。

2. 如果传递给Union方法的参数之间存在重叠的单元格区域，Union方法会将重叠区域重复计算。

cpearson.com提供了两段小代码来解决上述两问题。

下面的代码接受参数为Nothing。

'接受参数为NothingFunction Union2(ParamArrayRanges() As Variant) As Range Dim N As Long Dim RR As Range For N = LBound(Ranges) To UBound(Ranges) If IsObject(Ranges(N)) Then If Not Ranges(N) Is Nothing Then If TypeOf Ranges(N) IsExcel.Range Then If Not RR Is Nothing Then Set RR =Application.Union(RR, Ranges(N)) Else Set RR = Ranges(N) End If End If End If End If Next N Set Union2 = RREnd Function

下面的代码处理参数中重叠的区域。如果有重叠的区域，则只算1次。

'重叠区域中的数据只计算1次

Function ProperUnion(ParamArray Ranges() As Variant) As Range    Dim ResR As Range    Dim N As Long    Dim R As Range           If Not Ranges(LBound(Ranges)) Is NothingThen        Set ResR = Ranges(LBound(Ranges))    End If       For N = LBound(Ranges) + 1 ToUBound(Ranges)        If Not Ranges(N) Is Nothing Then            For Each R In Ranges(N).Cells                If Application.Intersect(ResR,R) Is Nothing Then                    Set ResR = Union2(ResR, R)                End If            Next R        End If    Next N    Set ProperUnion = ResREnd Function

注意，ProperUnion过程调用了Union2过程。

欢迎在下面留言，完善本文内容，让更多的人学到更完美的知识。

欢迎到知识星球：完美Excel社群，进行技术交流和提问，获取更多电子资料。