Получите нескомбинированный союз смежных объектов диапазона

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 символов. Если он превысит этот предел, он потерпит неудачу.