Question

考虑这个excel宏：

Dim Ra1 As Range, Ra2 As Range, RaUnified As Range

Set Ra1 = Range("B2:D4")
Set Ra2 = Range("E2:K4")

Set RaUnified = Union(Ra1, Ra2)

MsgBox RaUnified.Address(False, False) 
' Result: "B2:K4", but I'm searching a way to get the "B2:D4, E2:K4" not combined range

' Apply border formatting to each subranges in "one shot" :
RaUnified.Borders(xlEdgeLeft).Weight = xlMedium

我想知道是否可以得到Ra1和Ra2的未结合的联合，并且该解决方案不应该使用 Range("B2:D4, E2:K4")。

我只想知道Union是否还有其他功能/方法，可以使Range("B2:D4, E2:K4")和Ra1统一使用Ra2。

（目的是动态构建一个很大的范围对象联合，并对其进行一次格式化以优化性能）。

Answer 1

保持单独范围的一种方法是存储要使用的离散范围的集合或字典。它比您想要的代码稍微笨拙，但是您可以通过这种方式存储连续范围。缺点是您需要遍历每个范围以应用格式，而不是想要的“一次性”。

在名为“ RangeCollection”的类模块中

Option Explicit
Private myDictionary As Object

Private Sub Class_Initialize()
    Set myDictionary = CreateObject("Scripting.Dictionary")
End Sub

Private Sub Class_Terminate()
    Set myDictionary = Nothing
End Sub

Public Sub Add(ByRef rng As Range)
    If Not myDictionary.Exists(rng.Address) Then myDictionary.Add rng.Address, rng
End Sub

Public Sub Remove(ByRef rng As Range)
    If myDictionary.Exists(rng.Address) Then myDictionary.Remove rng.Address
End Sub

Public Property Get Count() As Double
    Count = myDictionary.Count
End Property

Public Property Get Reference() As Object
    Set Reference = myDictionary
End Property

然后在模块中，您可以添加集合并遍历范围以对其进行格式化...

Public Sub TestUnionRange()
    Dim RngColl As RangeCollection: Set RngColl = New RangeCollection
    RngColl.Add Range("B2:D4")
    RngColl.Add Range("E2:K4")

    Dim Coll As Object: Set Coll = RngColl.Reference()
    For Each Item In Coll.Keys()
        Range(Item).Borders(xlEdgeLeft).Weight = xlMedium
    Next Item

End Sub

Answer 2

Union将始终将连续范围合并为一个范围。但是，通过设置内部垂直边框，您仍然可以在两者之间设置边框：Borders(xlInsideVertical).Weight = xlMedium

例如：

Sub UnionBorders()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Tabelle2")

    Dim MyRange As Range

    Dim iRow As Long
    For iRow = 1 To 100 Step 4
        If MyRange Is Nothing Then
            Set MyRange = Union(ws.Range("B" & iRow & ":B" & iRow + 2), ws.Range("C" & iRow & ":C" & iRow + 2))
        Else
            Set MyRange = Union(MyRange, ws.Range("B" & iRow & ":B" & iRow + 2), ws.Range("C" & iRow & ":C" & iRow + 2))
        End If
    Next iRow

    ws.MyRange.Borders(xlInsideVertical).Weight = xlMedium
    ws.MyRange.Borders(xlEdgeLeft).Weight = xlMedium
End Sub

通过串联地址替代：

Sub ConcatBorders()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Tabelle2")

    Dim MyRangeAddress As String

    Dim iRow As Long
    For iRow = 1 To 20 Step 4
        If MyRangeAddress = vbNullString Then
            MyRangeAddress = ("B" & iRow & ":B" & iRow + 2) & "," & ("C" & iRow & ":C" & iRow + 2)
        Else
            MyRangeAddress = MyRangeAddress & "," & ("B" & iRow & ":B" & iRow + 2) & "," & ("C" & iRow & ":C" & iRow + 2)
        End If
    Next iRow

    ws.Range(MyRangeAddress).Borders(xlEdgeLeft).Weight = xlMedium
End Sub

但是请注意，这仅适用于不超过256个字符的短地址。如果超过该限制，它将失败。

获取连续范围对象的未组合并集

2 个答案: