将两个或多个连续范围合并为单个多区域范围

Question

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

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

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

为此，如果范围较小，我使用">范围"方法，例如：

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'的方法'范围'失败">

为了克服">范围"方法的这种限制，我使用了">联合"函数：

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"))

它适用于非连续范围。但是当所有范围都是连续的(如我的情况(时，">联合"将所有范围合并为一个">单区域范围"。即

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 个类，然后在需要时将范围包装在一起。

类代码(即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