スキップしてメイン コンテンツへ

 none
[Excel VBA] Union で隣接するセルを分割 (別の Area に) する方法 RRS feed

  • 質問

  • Excel VBA で Range に直接セル番地を入力する方法は文字数制限があるため、
    長い場合や、Range を追加したりするときは Union メソッドを使いますが、
    この Union メソッドで隣接するセルを追加したときはつながって 1 つの
    領域 (Area) になってしまうようです。
    (例: Union(Range("A1"), Range("A2")).Areas.Count は 1 になる)

    通常時はこれでいいのですが、事情でこれを分離したい事例がありました。
    なにか、いい方法はないでしょうか。

    実現できるなら Union でなくてもいいですが、Range("A1,A2") としたときと
    同じようにしたいのです。

    よろしくお願いいたします。

    2019年10月11日 5:54

回答

  • Option Explicit

    Sub test()
        Debug.Print SplitRange(Union(Range("A1,A2"), Range("A4,A5"))).Address(False, False)
    End Sub

    Function SplitRange(ByVal Rng As Range) As Range
        Dim Area As Range
        Dim Cell As Range
        Dim Ar() As String
        Dim indx As Long
        For Each Area In Rng.Areas
            For Each Cell In Area.Cells
                ReDim Preserve Ar(indx)
                Ar(indx) = Cell.Address
                indx = indx + 1
            Next Cell
        Next Area
        Set SplitRange = Range(Join(Ar, ","))
    End Function

    んな事でいいのかな。

    • 回答としてマーク infade 2019年10月18日 6:26
    2019年10月11日 11:53

すべての返信

  • Option Explicit

    Sub test()
        Debug.Print SplitRange(Union(Range("A1,A2"), Range("A4,A5"))).Address(False, False)
    End Sub

    Function SplitRange(ByVal Rng As Range) As Range
        Dim Area As Range
        Dim Cell As Range
        Dim Ar() As String
        Dim indx As Long
        For Each Area In Rng.Areas
            For Each Cell In Area.Cells
                ReDim Preserve Ar(indx)
                Ar(indx) = Cell.Address
                indx = indx + 1
            Next Cell
        Next Area
        Set SplitRange = Range(Join(Ar, ","))
    End Function

    んな事でいいのかな。

    • 回答としてマーク infade 2019年10月18日 6:26
    2019年10月11日 11:53
  • 回答ありがとうございます。
    返事が遅くなってすみません。

    やはり、ループ内でなんとかするしかないですか。
    実はやりたかったことの概要としては以下のようなものです。

        Range("a1:c1,d1:f1,a4:c4,d4:f4,a7:c7,d7:f7").Value = Array("見出し1", "見出し2", "見出し3")
    

    実際のセル領域はもう少し複雑で多いのですがこのアドレスをループ処理で
    作りたいのです。
    (イメージとしては以下のような感じのループで、セル領域だけ作って
    ループの外で代入する)

        Dim i As Long, j As Long
    
        For i = 0 To 2
            For j = 0 To 2
                Range("a1:c1").Offset(i * 3, j * 3).Value = Array("見出し1", "見出し2", "見出し3")
            Next
        Next
    

    Range に指定できる文字数には限界があるため、めったに限界まで行くことは
    ないと思いますがその上限を気にしなくてもいいようにやりたいと思いましたが
    ちょっと、難しそうなので諦めます。
    結局、ループ処理するなら同じようなものですしね。

    2019年10月18日 6:26