将两个或多个连续范围组合成单个多区域范围

Question

我正在为 Excel 开发一个实用程序 AddIn，它处理可变数量的 Ranges。它可以修改当前选择或创建新选择以供进一步使用：例如应用格式样式、合并和取消合并。

在这个插件中，我需要将许多连续范围组合成一个“多区域范围”说：

"A1:A10","A11:A20","A21:A30",......."A490:A500"

如果范围较少，我会使用“Range”方法，例如：

Addr="A1:A10,A11:A20,A21:A30"
Set Rng=Range(Addr)

它工作正常并创建一个“多区域范围”，其中：

Rng.Areas.Count       'is 3
Rng.Areas(1).address  'is "$A$1:$A$10"
Rng.Areas(2).address  'is "$A$11:$A$20"
Rng.Areas(3).address  'is "$A$21:$A$30"

但问题从地址长度参数大于255开始。在这种情况下，“范围”失败并且 抛出错误：即

Addr="A1:A10,A11:A20,A21:A30,A31:A40,A41:A50,A51:A60,A" & _
    "61:A70,A71:A80,A81:A90,A91:A100,A101:A110,A111:A" & _
    "120,A121:A130,A131:A140,A141:A150,A151:A160,A161" & _
    ":A170,A171:A180,A181:A190,A191:A200,A201:A210,A2" & _
    "11:A220,A221:A230,A231:A240,A241:A250,A251:A260," & _
    "A261:A270,A271:A280,A281:A290,A291:A300,A301:A31" & _
    "0,A311:A320,A321:A330,A331:A340,A341:A350,A351:A" & _
    "360,A361:A370,A371:A380,A381:A390,A391:A400,A401" & _
    ":A410,A411:A420,A421:A430,A431:A440,A441:A450,A4" & _
    "51:A460,A461:A470,A471:A480,A481:A490,A491:A500"
    Set Rng=Range(Addr)

抛出错误：“对象'_Global'的方法'Range'失败”

为了克服“Range”方法的这个限制，我使用了“Union”函数：

Set rng = Union( _
    Range("A1:A10,A11:A20,A21:A30,A31:A40,A41:A50,A51:A60"), _
    Range("A61:A70,A71:A80,A81:A90,A91:A100,A101:A110,A111:A120"), _
    Range("A121:A130,A131:A140,A141:A150,A151:A160,A161:A170"), _
    Range("A171:A180,A181:A190,A191:A200,A201:A210,A211:A220"), _
    Range("A221:A230,A231:A240,A241:A250,A251:A260,A261:A270"), _
    Range("A271:A280,A281:A290,A291:A300,A301:A310,A311:A320"), _
    Range("A321:A330,A331:A340,A341:A350,A351:A360,A361:A370"), _
    Range("A371:A380,A381:A390,A391:A400,A401:A410,A411:A420"), _
    Range("A421:A430,A431:A440,A441:A450,A451:A460,A461:A470"), _
    Range("A471:A480,A481:A490,A491:A500"))

很好与 非连续范围一起工作。但是当所有范围都是连续的（如我的情况）时，“Union”将所有范围合并为一个“Single Area Range”。即

Rng.Areas.Count       'is 1
Rng.Areas(1).Address  'is "$A$1:$A$500"

我需要一个“多区域范围”以供进一步使用，在哪里。

Rng.Areas.Count       'Must be 50
Rng.Areas(1).Address  'Must be "$A$1:$A$10"
Rng.Areas(2).address  'Must be "$A$11:$A$20"
Rng.Areas(3).address  'Must be "$A$21:$A$30"
.......
.......
Rng.Areas(50).address 'Must be "$A$491:$A$500"

不幸的是，“Range.Areas”属性是只读的。 所以我不能直接添加或删除任何元素。

请帮助我解决这个问题。

Answer 1

我没有找到在 Excel 中创建如此复杂的范围对象的任何方法，但我认为可以通过将多个范围包装到 1 个类对象中来实现您所期望的行为。 它不是现成的解决方案，而是如何实现它的想法。它必须根据您的需要进行调整。

这个想法是将单个范围包装到 1 个类中，然后在需要时合并范围。

类代码（即 MyRanges）：

Option Explicit
Private ranges As New Collection
Public Sub Add(rng As Range)
     ranges.Add rng
End Sub
Property Get MyAreas()
    Set Areas = ranges
End Property
Public Sub Remove(rng As Range)
    ranges.Remove rng
End Sub
Public Function GetRanges(ParamArray indexes()) As Range
Dim res As Range
Dim i As Integer

    Set res = ranges(indexes(0))
    If UBound(indexes) = 0 Then
        Set GetRanges = res
        Exit Function
    End If

    For i = 1 To UBound(indexes)
        Set res = Union(res, ranges(indexes(i)))
    Next i
    Set GetRanges = res

End Function

类的测试代码：

Public Sub Test()
Dim Addr As String
Dim Rng1 As Range, Rng2 As Range, Rng3 As Range, Rng4 As Range, Rng5 As Range, Rng6 As Range
Dim ranges As MyRanges
Dim result As Range

    Addr = "A1:A10"
    Set Rng1 = Range(Addr)
    Addr = "A11:A20"
    Set Rng2 = Range(Addr)
    Addr = "A21:A30"
    Set Rng3 = Range(Addr)
    Addr = "A31:A40"
    Set Rng4 = Range(Addr)
    Addr = "A41:A50"
    Set Rng5 = Range(Addr)
    Addr = "A51:A60"
    Set Rng6 = Range(Addr)

    Set ranges = New MyRanges
    ranges.Add Rng1
    ranges.Add Rng2
    ranges.Add Rng3
    ranges.Add Rng4
    ranges.Add Rng5
    ranges.Add Rng6

    Set result = ranges.GetRanges(1, 2)
    Debug.Print result.Address
    Set result = ranges.GetRanges(1, 3, 5)
    Debug.Print result.Address

End Sub