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

时间:2017-07-30 16:42:09

标签: excel excel-vba vba

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

在这个AddIn中,我需要将许多连续范围合并为一个“多区域范围”,并说:

"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”属性是readonly。 所以我不能直接添加或删除任何元素。

请帮助我来解决这个问题。

1 个答案:

答案 0 :(得分:0)

我没有找到任何方法在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