VBAの勉強を始めてみた

色々試しています。

ループ処理を極力軽くする方法の模索~混乱編~(Tips-7)

VBAの勉強を始めて、これまでに学んだことや、思いついたアレやコレをメモっておきます。

 

今回は、ループ処理を使わなければならない場合に、ループの中に含まれる処理を極力軽くする方法について、模索してみようと思います。

下のように、1~9の数値がランダムに入った、A1:A10000のセル範囲に対して、数値が偶数だった場合に行を非表示にする処理を、いくつかのコードで試して、速さの違いを比較してみましょう。

f:id:kouten0430:20180624151654j:plain


test1として、セルを上から順に比較していき、偶数だった場合にその都度、行を非表示にします。
(Modは、左側の数値を右側の数値で割って、余りを求める演算子です。なので、2で割った時に0であった場合が偶数ということになります)
※時間計測のために必要なコードは省略して記載します。

Sub test1()
    Dim i As Integer
    
    For i = 1 To 10000
        If Cells(i, 1).Value Mod 2 = 0 Then
            Rows(i & ":" & i).Hidden = True
        End If
    Next i
    
End Sub

 

 上記のコードでかかった時間は、

f:id:kouten0430:20180624150823j:plain

7秒

 

次に、test2として、セルを上から順に比較していき、偶数だった場合にその都度、行をUnionメソッドで取り込み、最後にまとめて非表示にします。

Sub test2()
    Dim i As Integer
    Dim myRange As Range
    
    For i = 1 To 10000
        If Cells(i, 1).Value Mod 2 = 0 Then
            If myRange Is Nothing Then
                Set myRange = Range(i & ":" & i)
            Else
                Set myRange = Union(myRange, Range(i & ":" & i))
            End If
        End If
    Next i

    myRange.EntireRow.Hidden = True

End Sub

 

上記のコードでかかった時間は、

f:id:kouten0430:20180624150909j:plain

56秒

あれ?

 

最後にまとめて、非表示にするほうが速いと思っていたんですが・・・・・・。

 

と、とりあえず、次に、test3として、A1:A10000の範囲を配列に取り込んでから比較し、偶数だった場合にその都度、行をUnionメソッドで取り込んで、最後にまとめて非表示にします。

Sub test3()
    Dim i As Integer
    Dim myRange As Range
    
    Tdim = Range("A1:A10000")
    
    For i = 1 To 10000
        If Tdim(i, 1) Mod 2 = 0 Then
            If myRange Is Nothing Then
                Set myRange = Range(i & ":" & i)
            Else
                Set myRange = Union(myRange, Range(i & ":" & i))
            End If
        End If
    Next i

    myRange.EntireRow.Hidden = True
    
End Sub

 

上記のコードでかかった時間は、

f:id:kouten0430:20180624151057j:plain

56秒

変わらない・・・・・・。

 

最後に、test4として、A1:A10000の範囲を配列に取り込んでから比較し、偶数だった場合にその都度、行を非表示にします。

Sub test4()
    Dim i As Integer
    Dim myRange As Range
    
    Tdim = Range("A1:A10000")
    
    For i = 1 To 10000
        If Tdim(i, 1) Mod 2 = 0 Then
            Rows(i & ":" & i).Hidden = True
        End If
    Next i

End Sub

 

上記のコードでかかった時間は、

f:id:kouten0430:20180624151130j:plain

7秒
test1と変わらないね(@_@;)

 

test1~4をまとめると、下表のようになりました。

方法 時間
1セルごとに比較し、1行ずつ非表示にする 7秒
1セルごとに比較し、Unionメソッドで取り込んだ行を最後にまとめて非表示にする 56秒
配列の中で比較し、Unionメソッドで取り込んだ行を最後にまとめて非表示にする 56秒
配列の中で比較し、1行ずつ非表示にする 7秒

 

えーっと。
自分の予想では、速い順に、test3 < test2 < test4 << test1 だったのですが。
すべて予想と違い、若干混乱しております(@_@;)

Unionメソッドってもしかして、時間のかかる処理なのかな?

セル比較と配列比較で時間が変わらなかったのは、サンプルデータが少なかったからでしょうか。それとも何か、見落としていることがある?

 

というか、今日は何を模索するんだっけ?あれ??

指定した数の行を一瞬で挿入するには?(Tips-6)

VBAの勉強を始めて、これまでに学んだことや、思いついたアレやコレをメモっておきます。

 

今回は、VBAで、ユーザーが指定した数の行を挿入する方法についてです。

まず、下のように、For ~Next を使って、指定した数の行を挿入させてみようと思います。
アクティブセルがある行の上方向に、行挿入する処理を n回 繰り返します。

Sub test1()
    Dim n As Long

    n = InputBox("挿入する行数を入力して下さい")
    
    For i = 1 To n
        ActiveCell.EntireRow.Insert xlShiftDown, xlFormatFromLeftOrAbove
    Next i

End Sub

 

1~1,000行程度であれば、ほぼ一瞬で完了しますが、10,000行辺りから少し時間がかかるようになってきます。100,000行になると・・・・・・、

f:id:kouten0430:20180623150309j:plain

3分13秒

うーん。カップラーメンが出来てしまいますぅ(@_@;)

 

上記は、VBAの勉強を始めた初期の頃に作ったコードです。今見ると、腹パンしてやりたくなりますね。
前回も書きましたが、ループというのは掛け算であり、処理の内容によっては、とんでもなく時間がかかってしまうんです・・・・・・。

実際に100,000行も挿入するようなことはあまりありませんが、私はこのコードが気に入らず、コードを書いた当日はずっとモヤモヤした気分でした。

 

しかし、翌日ふと、次のような処理を思いつき、コードを修正しました。

Sub test2()
    Dim n As Long

    n = InputBox("挿入する行数を入力して下さい")

    Rows(ActiveCell.Row & ":" & ActiveCell.Row + n - 1).Insert xlShiftDown, xlFormatFromLeftOrAbove

End Sub

 

アクティブセルがある行から下に n行 選択した状態で、行挿入を1回だけ行うのです。単純ですね。


エクセルの操作に例えるとこんな感じ、

f:id:kouten0430:20180623150424j:plain

2~11行目を(要するに2行目を始点にして10行分)選択した状態で「挿入」します。

 

f:id:kouten0430:20180623150539j:plain

すると、1行目と2行目の間に10行挿入されます。

上記のコードでやっているのは、これと同じようなことです。

 

このコードで、100,000行挿入した時の時間は・・・・・・、

f:id:kouten0430:20180623150643j:plain

0秒

なーんだ、ループを使わなくてもできる方法があるじゃないか。


test1,test2 について、処理にかかった時間をまとめると下表のようになりました。

挿入する行数 test1 test2
10 0秒 0秒
100 0秒 0秒
1,000 1秒 0秒
10,000 9秒 0秒
100,000 3分13秒 0秒
1,000,000 計測不能 0秒

 

これで、test1のコードは実用に耐えないことが分かります。ある程度、VBAに慣れてくると、test1のようなコードは実行するまでもなく、時間がかかることが分かるようになってくるので、最初から別の方法でコーディングすることを考えるようになってきます。

 

 初心者の私は、こんな感じで処理を効率化できたときの嬉しさが忘れられず、そして、これからも味わうために、プログラミングにハマっているのかもしれません。

 

今回のような例は、ExcelVBA ならではのものなのかもしれませんが(@_@;)

 

前回はワークシート関数でループ処理を代替し、今回はその他の方法でループ処理を代替してみました。次回は、ループをどうしても使わなければならない場合に、処理をできるだけ軽くする方法などを模索してみようと思います。

空白以外のセルを一瞬でカウントするには?(Tips-5)

VBAの勉強を始めて、これまでに学んだことや、思いついたアレやコレをメモっておきます。

 

今回は、VBAで、セルにデータが有るか無いか(または特定のデータが有るか無いか、でもいい)を調べて、そのデータ数をカウントする方法についてです。

まず、下のように、For Each ~Next を使って A1:Z1048576 の範囲にデータがいくつ存在しているかをカウントしてみようと思います。
セルが空白ではない場合に、cnt を +1 します。

Sub test1()

    For Each myRange In Range("A1:Z1048576")
        If myRange.Value <> "" Then
            cnt = cnt + 1
        End If
    Next myRange
    
End Sub

 

おっと、その前に、処理にどのくらい時間がかかったのかを調べるために、時間計測できる仕掛けを組み込んでおきましょう。

Sub test1()

    StartTime = Time

    For Each myRange In Range("A1:Z1048576")
        If myRange.Value <> "" Then
            cnt = cnt + 1
        End If
    Next myRange
    
    StopTime = Time
    MsgBox "処理にかかった時間は" & vbCrLf & Minute(StopTime - StartTime) _
    & "分" & Second(StopTime - StartTime) & "秒"
    
End Sub

 

さあ、これでかかった時間は・・・・・・、

f:id:kouten0430:20180616165838j:plain

1分58秒

・・・・・・結構、かかったね(@_@;)

 

次は、A1:Z1048576 の範囲を配列に代入してから、配列をループして調べる方法を試してみます。配列の中身が空白ではない場合に、cnt を +1 します。

Sub test2()

    StartTime = Time

    Tdim = Range("A1:Z1048576")
    
    For i = 1 To 1048576
        For j = 1 To 26
            If Tdim(i, j) <> "" Then
                cnt = cnt + 1
            End If
        Next j
    Next i
    
    StopTime = Time
    MsgBox "処理にかかった時間は" & vbCrLf & Minute(StopTime - StartTime) _
    & "分" & Second(StopTime - StartTime) & "秒"
    
End Sub

 

かかった時間は・・・・・・、

f:id:kouten0430:20180616170038j:plain

5秒

圧倒的に速くなりましたよ!

 

この結果から、配列へのアクセスが速いこと(言い換えればループの都度、セルへアクセスすることが時間のかかること)が分かります。
ループというのは掛け算であり、ループの中に入っている処理が少し重いだけで、ループ回数によってはとんでもない時間を要してしまうんですよね・・・・・・。

 

でも、セルにデータが有るか無いかを調べるのであれば、もっと速い方法がありますよね?

それは、ワークシート関数を利用することです。test1、test2と同じ処理をワークシート関数を使って、書き直してみましょう。
CountIfで、空白以外のセル数をカウントさせます。

Sub test3()

    StartTime = Time

    cnt = WorksheetFunction.CountIf(Range("A1:Z1048576"), "<>")
    
    StopTime = Time
    MsgBox "処理にかかった時間は" & vbCrLf & Minute(StopTime - StartTime) _
    & "分" & Second(StopTime - StartTime) & "秒"
    
End Sub

 

かかった時間は・・・・・・、

f:id:kouten0430:20180616170224j:plain

0秒

速い!しかも、コードがすっきりするというオマケつき。

 

test1~3について、それぞれにかかった時間をまとめると下のようになります。 

方法 時間
For Each ~Next で1セルずつ調べる 1分58秒
配列に格納してから調べる 5秒
ワークシート関数で調べる 0秒

 

こうやって見ると、ワークシート関数が圧倒的に速いんですよね。

いや、けして、ワークシート関数利用推進派の回し者ではありませんよ。

 

おまけ:
今回のコードでは、A1:Z1048576 のセル範囲を試験的に調べましたが、じゃあ、A1:XFD1048576 の範囲(要するにシート内のすべてのセル)だったらどのくらい時間がかかるの?ということで、補足しておきます。
私のPCスペックでは、test1のケースで、単純計算で20時間かかり、test2のケースでは、メモリ不足のためテストすることすらできません。
しかし、test3のワークシート関数であれば、なんと!それでも 0秒 で処理が完了してしまいます。普段、ワークシート関数を使う分には何の疑問も抱きませんが、こうやって他の方法と比較してみると、「どうやって処理してるの?」と不思議に思ったりもします。

 

次回は、ワークシート関数以外で、ループ処理をなるべく使わずに済む方法を模索したり、ループ処理をどうしても使わなければならない場面で、ループ回数の掛け算の被乗数側となる処理をできる限り軽くする方法などについて考えてみたいと思います(@_@;)

InputBoxのキャンセル判定について(Tips-4)

VBAの勉強を始めて、これまでに学んだことや、思いついたアレやコレをメモっておきます。

 

今回は、InputBoxでキャンセルを押された場合の判定についてです。

InputBoxでキャンセルを押されたときに、何らかの処理(例えばプロシージャを終了するとか)をさせるために、下記のような条件分岐を入れることがあると思います。

Sub test()
    tmp = InputBox("何か入力して下さい")
        If tmp = "" Then
            Exit Sub
        End If
End Sub

 

InputBox関数でキャンセルを押された場合の戻り値は、空白(長さ0の文字列)です。
なので、変数の中身が空白であった場合は、条件分岐で Exit Sub をさせるわけです。

では、戻り値に空白そのものを使用したい場合はどうでしょう?
上記のコードでInputBoxを空白のままでOKしても、結局、変数の中身は空白であり、キャンセルと同じく Exit Sub されてしまいます。

 

このようなケースでは、InputBox関数ではなく、InputBoxメソッドを使用すると便利です。

InputBoxメソッドでキャンセルを押された場合は、戻り値にBoolean型の False が返ってきますので、変数の型が Variant であれば、下記のように条件分岐させることができます。

Sub test()
    tmp = Application.InputBox("何か入力して下さい")
        If TypeName(tmp) = "Boolean" Then
            Exit Sub
        End If
End Sub

 

TypeName関数で変数のデータ型を調べ、Boolean型であれば条件分岐で Exit Sub するようにしています。

では、変数をVariant型ではなく、数値型や文字列型などで宣言した場合はどうなるでしょうか?
やってみましょう。
変数を数値型にして、キャンセルした場合は False に該当する数値の 0 が入るので、

Sub test()
    Dim tmp As Integer
    
    tmp = Application.InputBox("何か入力して下さい")
        If tmp = 0 Then
            Exit Sub
        End If
End Sub

 

のように条件分岐させることができます。

ではでは、変数を文字列型にした場合はどーでしょう?
変数を文字列型にして、キャンセルした場合は False という文字列が入るので、

Sub test()
    Dim tmp As String
    
    tmp = Application.InputBox("何か入力して下さい")
        If tmp = "False" Then
            Exit Sub
        End If
End Sub

 

のように条件分岐させることができます。

ただし、上記二つの例は 0 という数値と、False という文字列が戻り値として扱えなくなってしまうため、理由がなければ、変数は Variant で宣言すれば良いでしょう。

 

ちなみに、InputBoxメソッドはモードレスなので、入力する数値や文字列をセルから選ぶこともできます。

  • モードレス:ダイアログボックスが表示されている間、ダイアログボックス以外の操作もできる状態
  • モーダル:ダイアログボックスが表示されている間、ダイアログボックス以外の操作ができない状態(InputBox関数で表示されるダイアログボックスはモーダル)

 

ダイアログボックスが表示されている状態で、セルを範囲選択すれば、Range(セル範囲)を入力することもできます。
しかし、戻り値をRange型(要するにオブジェクト)にする場合は、必ず先頭に Set をつけて、

Set tmp = Application.InputBox(prompt:="何か入力して下さい", Type:=8)

のように、書く必要があるため、この時点でBoolean型のデータは代入することができなくなってしまいます。
何を言いたいかというと、この Set がついていると、キャンセルしたときに「オブジェクトが存在しないぜ」ってことで、エラーが発生するってことです。

うーん・・・・・・。じゃあ、キャンセル判定どーしようか?

エラーになるっていうことは、変数は空っぽのままのハズなので、次のようにしてみましょう。

Sub test()
    Dim tmp As Range
    
    Set tmp = Application.InputBox(prompt:="何か入力して下さい", Type:=8)
        If tmp Is Nothing Then
            Exit Sub
        End If
End Sub

 

tmp Is Nothing で、オブジェクト変数が空っぽ(Nothing)ならば、条件分岐で Exit Sub させます。

 

え?・・・・・・なんか足りない?

そもそも、エラーが発生した行で処理が止まってしまうので、以下の記述をさらに追加する必要があります。

Sub test()
    Dim tmp As Range
    
    On Error Resume Next
    
    Set tmp = Application.InputBox(prompt:="何か入力して下さい", Type:=8)
        If tmp Is Nothing Then
            Exit Sub
        End If
        
    On Error GoTo 0
    
End Sub

 

On Error Resume Next から下の行は、エラーが発生しても、エラーを無視してそのまま処理を続けるようになります。

そして、On Error GoTo 0 で、On Error Resume Next の効果を解除します。

 

これで、Range型の場合のキャンセル判定もできるようになりましたね! 

 

※Range型のキャンセル判定のケースは インストラクターのネタ帳 というサイトを参考にさせていただきました。

多重ループを一気に抜けるには?(Tips-3)

VBAの勉強を始めて、これまでに学んだことや、思いついたアレやコレをメモっておきます。

 

タイトルのとおりですが、コーディングしていると、入れ子になったループの中から一気に抜け出したい場面があります。
しかし、下記のように、一番内側のループの中で Exit For しても、ループを抜けるのは該当の For ~Next だけで、外側のループまでは抜けることができません。

Sub test()
    For i = 1 To 10
        For j = 1 To 10
            For k = 1 To 10
                If k = 5 Then
                    Exit For
                End If
            Next k
        Next j
    Next i
End Sub

 

こういうとき私は、初心者モード全開で、GoTo を乱用するのですが、

Sub test()
    For i = 1 To 10
        For j = 1 To 10
            For k = 1 To 10
                If k = 5 Then
                    GoTo skip
                End If
            Next k
        Next j
    Next i
    
skip:

End Sub

 

ネットでいろいろ調べていると、可読性が下がるとか、うんぬんとかであまり好まれていないようです。

じゃあどうすればいいのさっ!?ということで、別の方法を学んでみました。

 

Exit For と一緒に、外側のループ終了条件も満たしてあげる方法

Sub test()
    For i = 1 To 10
        For j = 1 To 10
            For k = 1 To 10
                If k = 5 Then
                    i = 10
                    j = 10
                    Exit For
                End If
            Next k
        Next j
    Next i
End Sub

 

フラグを True にし、フラグが True なら条件分岐で外側のループも Exit For する方法

Sub test()
    For i = 1 To 10
        For j = 1 To 10
            For k = 1 To 10
                If k = 5 Then
                    flag = True
                    Exit For
                End If
            Next k
        If flag Then Exit For
        Next j
    If flag Then Exit For
    Next i
End Sub

 

他にもいろいろあると思いますケド、初心者的には、ぱっと見、GoTo が一番わかりやすいように思えるのは気のせい?
でも、一つのコードの中で GoTo を多用すれば、スパゲッティのようにコードが絡み合い、可読性が下がってしまうことでしょう。

どれが正統なやり方なの?って思いますが、組織で決まったお作法(指針?)などがあれば、それに従い、個人レベルであれば本やネットを参考に汎用性やメンテナンス性を高めたり、ミスを防いだりするための、個人ルールを構築するって感じでしょうか。
うーん。まだまだ知らないことが多くありそうですが・・・・・・、「お作法」の存在を気にしすぎて、自由な発想が妨げられないようにもしたい今日この頃であります。

可視セルのみを二次元配列に格納するには?(Tips-2)

VBAの勉強を始めて、これまでに習得したことや、思いついたアレやコレをメモっておきます。

 

結論から言うと、あらかじめ用意されているプロパティやメソッドなどで、可視セル範囲のみをうまいこと二次元配列に格納することはできないようです。(あくまでも、浅学な私が調べたところでは、です)

下記のような、3行目と3列目を非表示にした範囲から、可視セルのデータのみを配列に格納してみましょう。

f:id:kouten0430:20180526120458j:plain

 

まず、一番最初に思いつくのは、
配列 = Selection.SpecialCells(xlCellTypeVisible)
です。
Selection.SpecialCells(xlCellTypeVisible) は、選択範囲の可視セルのみを取得するプロパティなので、これであっさり、可視セルのみを二次元配列に格納できる!と思ったのですが・・・・・・どうもうまくいきません。

ローカルウィンドウで配列の中身を確認すると、このように、1,2,6,7しか取り込まれていません。あれれ?

f:id:kouten0430:20180526120553j:plain

 

さきほどの非表示の行、列を再表示してみましょう。(3行目と、3列目に色をつけてみました)

f:id:kouten0430:20180526120636j:plain


この非表示の行、列を境に右側、下側が配列に取り込まれていないようです。
配列ではなく、Range型のオブジェクト変数に代入してローカルウィンドウで変数の中身を見ると分かるのですが、

この場合、Areas(範囲のひとかたまり)が4つ存在していることが分かります。

f:id:kouten0430:20180526120713j:plain

 

この非表示セルで分断された、4つの範囲のことですね。

f:id:kouten0430:20180526120748j:plain

 

Selection.SpecialCells(xlCellTypeVisible)を受け取る変数が配列だと、左上のAreasしか代入できない仕様のようです。

 

でも、コードをうまいこと組み合わせれば、なんとかできるハズ!ということでやってみました。

可視セル範囲の行数、列数をカウントして、配列の要素数を再定義し、For ~Nextで列・行方向に非表示セルを除いてデータを取り込む作戦です。

しかし、ここでまたAreas問題にぶち当たります。

Selection.SpecialCells(xlCellTypeVisible).Rows.Count で、行数をカウント
Selection.SpecialCells(xlCellTypeVisible).Columns.Count で、列数をカウント
しようとするも、左上のAreasのぶんしかカウントしてくれません。

う~ん。

しかたないので、苦肉の策(?)で、このようにカウントの仕方を変えます。
Selection.Rows(1).SpecialCells(xlCellTypeVisible).Cells.Count で、選択範囲の1行目の可視セル数をカウント
Selection.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count で、選択範囲の1列目の可視セル数をカウント

ふぅ・・・・・・。これでやっと、可視セル範囲の行数、列数をカウントし配列の要素数を再定義することができました。
ここまでくれば、あとはわりとカンタンな気がします。
For ~Next jで列のデータを、For ~Next iで行のデータを順次、二次元配列に取り込みます。

f:id:kouten0430:20180526121109j:plain

コードはコレ

    y = Selection.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count
    x = Selection.Rows(1).SpecialCells(xlCellTypeVisible).Cells.Count
    
    ReDim Tdim(1 To y, 1 To x)
    
    dim1 = 1
    dim2 = 1
        
    For i = Selection.Row To Selection.Rows(Selection.Rows.Count).Row
        For j = Selection.Column To Selection.Columns(Selection.Columns.Count).Column
            If Rows(i).Hidden = False And Columns(j).Hidden = False Then '非表示セルは処理しない
                Tdim(dim1, dim2) = Cells(i, j).Value
                    dim2 = dim2 + 1
                    If dim2 > x Then
                        dim2 = 1
                        dim1 = dim1 + 1
                    End If
            End If
        Next j
    Next i

 

重要なのは、表示されている列・行のみに処理を行うということです。合わせて、処理ごとに、一次元の要素数に +1 していきます。
jが右端まで来ると、一次元の要素数を1にリセットし、二次元の要素数を繰り上げます(カンタンに言うと、一行下がって左端に戻るようなことです)
これを、jとiが最後の値になるまで繰り返します。(この繰り返しの中で、Ifの条件を満たす回数と、配列の再定義した要素数が一致することがミソです)

ローカルウィンドウで結果を見てみます。

f:id:kouten0430:20180526121335j:plain

うまいこと、選択範囲の可視セルのみが順番どおりに格納されていますね。

他にもっと良い方法があるのかもしれませんが、今の私のレベルで思いつくのはここまでです!

 

余談:
Selection.SpecialCells(xlCellTypeVisible)を、For Each ~Nextでループすると、Areasごとに下のような順で処理が進んでしまうため、選択範囲と同じ並びで二次元配列に格納することができません。

f:id:kouten0430:20180526121619j:plain

結合セルを擬似的に単一セルのように扱うには?(Tips-1)

VBAの勉強を始めてみて、これまでに気づいたことや、習得したこまごました知識などをメモっておこうと思います。

 

下の画像のように、A1:C3を結合したセルがあります。

f:id:kouten0430:20180524221841j:plain

見た目は一つのセルのようですが、実際には9個のセル(A1,B1,C1,A2,B2,C2,A3,B3,C3)が含まれてます。

ここで「テスト」という文字列を変数に格納するためのコードを書いてみようと思うのですが、「テスト」という文字列が入っているのは、実際には結合セルの左上セル(A1セル)のみであり、この結合セルを選択した状態で、For Each ~Nextで処理しようとすると・・・・・・

Sub test()
    Dim V As String
    
    For Each C In Selection
        V = C.Value
        Debug.Print V
    Next C
End Sub

f:id:kouten0430:20180524220326j:plain

「テスト」という文字列が1回と、空白が8回、変数に格納されることになります。(イミディエイトウィンドウで空白が分かるように、ドラッグして選択しています)
結合セルに対しては、結合セルに含まれる全ての単一セルに対してループ処理を行うため、このような結果になります。

 

さて、これを単一セルのように扱うにはどうしたらいいでしょうか?
VBAには結合セルの範囲を取得する MergeAreaプロパティ というものがあります。

Range("A1").MergeArea

と書けば、A1セルが含まれる結合セル範囲を取得することができます。(先の結合セルであれば、単一セルを9個格納したコレクションとして取得されます)


インデックス番号で表すと下の画像のようになります。

f:id:kouten0430:20180524221654j:plain

 

ここで、
Range("A1").MergeArea(1).Address

と書けば、セルA1が含まれる結合セル範囲のインデックス番号1のアドレスを取得します。(返り値は、 $A$1 です)

"A1"の部分が、"B1","C1","A2","B2","C2","A3","B3","C3"に変わろうとも、アドレスを取得するセルはMergeArea(1)のセルなので、返り値はすべて $A$1 になります。

この特性を利用して、次のような条件式を作ってみます。

If 単一セル.Address = 単一セル.MergeArea(1).Address Then

 何らかの処理

End If

 

この、単一セルの箇所に、A1,B1,C1,A2,B2,C2,A3,B3,C3を順に当てはめると、 

A1は  True で、それ以外は False になります。

Range("A1").Address = Range("A1").MergeArea(1).Address ←True
Range("B1").Address = Range("B1").MergeArea(1).Address ←False
Range("C1").Address = Range("C1").MergeArea(1).Address ←False
Range("A2").Address = Range("A2").MergeArea(1).Address ←False
Range("B2").Address = Range("B2").MergeArea(1).Address ←False
Range("C2").Address = Range("C2").MergeArea(1).Address ←False
Range("A3").Address = Range("A3").MergeArea(1).Address ←False
Range("B3").Address = Range("B3").MergeArea(1).Address ←False
Range("C3").Address = Range("C3").MergeArea(1).Address ←False


つまり、これを利用してセルA1(結合セルの左上)にのみ処理を行う、という条件を作ることができるのです。

For Each ~Next的に書くと次のようになります。

Sub test()
    Dim V As String
    
    For Each C In Selection
        If C.Address = C.MergeArea(1).Address Then
            V = C.Value
            Debug.Print V
        End If
    Next C
End Sub

f:id:kouten0430:20180524222650j:plain

このコードを実行した結果、「テスト」という文字列が1回、変数に格納されるだけでプログラムが終了します。(イミディエイトウィンドウには、テストという文字列のみ出力されています)

 

このような条件を組み込めば、結合セルを擬似的に単一セルのように扱うことができますね!