別リストの条件に合う項目だけ処理をする

リハビリシステムより集計表がExcel形式出力されますが、多少修正したい箇所があり、これをVBAで一発処理できるようにしました。いろいろ調べましたが、結局2重ループを使って地道に調べるのが分かりやすいし無難でした。ついでに、forとfor eachの処理速度もチェックしてみました。


集計で問題となったのが、単位ではなく加算の部分。早期加算などの加算部分も人数や単位数合計が出てますが、本体は単位に付随してるものなので、合計に足してしまうと重複になってしまう。これを合計に反映しないよう出力してもらうことはできたが、表を見ると合計に反映される数、反映されない数が混在してしまい、分かりずらい。そこで、合計に反映されない部分の数字は、かっこに入れてしまうことにした。

方法は、別シートに「合計に反映されない項目リスト」を作り、そこに該当する項目の「人数」「単位数」は合計に反映しない。しかしながら加算で生じる点数は合計に反映される必要があるので、これはかっこに入れない。

実際に作ったものは、セキュリティの関係上端末外に出せないので、ここでは「乱数で発生させた数字のうち、リストに該当するもの(今回は奇数)にチェックを入れる」というコードを例として作ってみた。

Sub FindKisu()

    Dim iRange As Range
    Dim jRange As Range
    Dim listRange As Range
    Dim checkRange As Range
    Dim myCheck As Boolean
    Dim start As Single
    Dim finish As Single
    
    Set listRange = Range("A1:A50000") '本リストを設定
    Set checkRange = Range("D3:D7")	'チェックリストを設定

まず変数宣言と、本リストとチェックリストの設定
start,finishは時間測定用なので、本来は不要。

    '乱数使い、セルに数字を入力
    For Each iRange In listRange
        iRange.Value = CLng(Rnd() * 10)
    Next

乱数を使い、0から10までのばらばらの数字を、本リストに設定。

    start = Timer   '開始時間をセット

処理開始時間をセット。作りこむときは時間を計りながらコードを実行させると、処理時間の違いが分かるので便利。

    '2重ループで、条件に合ったセル右にメッセージを表示
    For Each iRange In listRange
        myCheck = False
        With iRange
            For Each jRange In checkRange
                If .Value = jRange.Value Then
                    myCheck = True
                End If
            Next
            If myCheck = True Then
                .Offset(0, 1).Value = "奇数"
            Else
                .Offset(0, 1).Value = ""
            End If
        End With
    Next

そして2重ループで地道にチェック。該当部分があると、myCheckがTrueにチェックされている。ここで必要な処理をしてもいいが、Falseの場合も処理ができるよう、このようなコードにした。
2重目のループを抜けてから、myCheckがTrueなら"奇数"を、Falseなら""を入力している。

    finish = Timer  '終了時間をセット
    Debug.Print finish - start  '
かかった秒数を表示

終わったら終了時間をセットし、かかった時間を表示。5万行の処理ですが、約1.8秒で処理できてます。

f:id:Hanamaru:20140208104224j:plain
処理後のシートはこんな感じ。

最後に、複数のセル範囲の処理をする場合の、forとfor eachを使った場合の処理時間を比較してみました。昔は「for eachの方が処理が早い」と言われてましたが、どうなんだろう。

Sub TestFor()

    Dim i As Long
    Dim start As Single
    Dim finish As Single
    
    start = Timer   '開始時間をセット
    For i = 1 To 50000
        Cells(i, 1).Value = "for"
    Next i
    finish = Timer  '終了時間をセット
    Debug.Print finish - start  'かかった秒数を表示
    
End Sub

まずはforを使い、5万行を処理した時間を計測。1.06秒でした。

Sub TestForEach()

    Dim iRange As Range
    Dim start As Single
    Dim finish As Single
    
    start = Timer   '開始時間をセット
    For Each iRange In Range("A1:A50000")
        iRange.Value = "each"
    Next
    finish = Timer  '終了時間をセット
    Debug.Print finish - start  'かかった秒数を表示
    
End Sub

次はfor eachを使い、同様の処理を実施。こちらは0.97秒でした。

ということで、for eachを使ったほうが早いですが、10%程度早くなる程度で、今回の処理時間の差は0.1秒くらい。微々たるものでした。
ただし、for eachでセル範囲を処理する場合、不規則なセル範囲であっても順番に処理してくれるので、やはりセル範囲を順番に処理する場合は、for eachを使ったほうが良さそうです。

【追記】
肝心の、数字の入ったセルにかっこをつける方法を書き忘れてました。
該当セルに対し、以下の処理をすればOKです。
数字は変えず、書式変更で行っています。

Range("A1").NumberFormatLocal = """(""0"")"""