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

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

excelperfect

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

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

代码语言：javascript复制

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

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

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

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

代码语言：javascript复制

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

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

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

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

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

代码语言：javascript复制

'接受参数为Nothing
Function 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 = RR
End Function

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

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

代码语言：javascript复制

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 = ResR
End Function

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

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

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

vba

0 人点赞