2017年06月13日

【Excel】オリジナルの家計簿作り⑩(おまけ)

一応、当初予定をしていた家計簿のプログラムは作成し終えました。

sub タイトル()
    dim 最終行 as long, 処理行 as long
    dim 日付 as date
    dim シート as worksheet
    dim flag as boolean
    dim シート名 as string
    最終行=cells(rows.count,2).end(xlup).row
    for 処理行=3 to 最終行
        'ここに順繰り回してどうすのかという指示文を入力します
        日付=cells(処理行,2).value
        シート名 = year(日付) & "年" & month(日付) & "月"
        '日付に合致する月のシートがあるか確認する
        for each シート in thisbook.worksheets
            flag=false
            if シート.name = シート名 then
                flag=true
                exit for
            end if
        next シート
        'もし、フラグが立っていたら、シートを作成する
        'フォーマットシートのコピー
        worksheets("フォーマット").copy after:=worksheets("フォーマット")
        activesheet.name = シート名

        '転記する
        dim 列 as long, 転記先 as long
        for 列 = 2 to 5
            転記先 = worksheets(シート名).cells(rows.count,2).end(xlup).row + 1
            worksheets(シート名).cells(転記先,列)=cells(処理行,列)
        next 列
    Next 処理行
end sub


今日は、転記先シートのリストを昇順で並び替えてみます。
構文としては、下記になります。
Range(並び替える範囲).Sort key1:=基準セル1, Order1:=昇順か降順か, key2:=基準セル2, Order2:=昇順か降順か, Header:=並び替えの範囲の先頭をタイトル行とするか否か

このように、基準セルを複数選択でき、個別に昇順・降順を設定できるので、
複雑な並び替えも可能です。

うちの場合は、日付(B列)→ 品目(C列)→ 使用者(F列)の優先順位で昇順に並び替えをしています。

.Range(.Cells(1, 1), .Cells(lngSh, 6)).Sort key1:=.Cells(1, 2), Order1:=xlAscending, key2:=.Cells(1, 3), Order2:=xlAscending, key3:=.Cells(1, 6), Order3:=xlAscending, Header:=xlYes


上記は、セルを指すアドレスの前に「.」が付いています。
これは、「with~end with」の構文を使うときに使用するもので、
「with」で指定した中の何かを指します。

今回は、「with」でシートを指定し、その中のセルであることを指します。

with worksheets(シート名)
    .Range(.Cells(1, 1), .Cells(lngSh, 6)).Sort
    _key1:=.Cells(1, 2), Order1:=xlAscending,
    _key2:=.Cells(1, 3), Order2:=xlAscending,
    _key3:=.Cells(1, 6), Order3:=xlAscending, Header:=xlYes
end with


このようにすることで、毎回シートを指定する手間を省き、文を短くすることによって見やすくできます。
なので、今までの文もこの「with」を使えば、もっと短くなったりもします。

また、プログラムの前に「application.screenupdating=false」を入れることにより、
プログラムが動いている間の描写(更新)を止めることができ、処理速度が早くなります。
※最後は値を「true」に戻します。

ということで、まとめ。

sub タイトル()
    dim 最終行 as long, 処理行 as long
    dim 日付 as date
    dim シート as worksheet
    dim flag as boolean
    dim シート名 as string

    application.ScreenUpdating=false

    with activesheet
        最終行=.cells(rows.count,2).end(xlup).row
        for 処理行=3 to 最終行
            'ここに順繰り回してどうすのかという指示文を入力します
            日付=.cells(処理行,2).value
            シート名 = year(日付) & "年" & month(日付) & "月"
            '日付に合致する月のシートがあるか確認する
            for each シート in thisbook.worksheets
                flag=false
                if シート.name = シート名 then
                    flag=true
                    exit for
                end if
            next シート
            'もし、フラグが立っていたら、シートを作成する
            'フォーマットシートのコピー
            worksheets("フォーマット").copy after:=worksheets("フォーマット")
            activesheet.name = シート名

            '転記する
            dim 列 as long, 転記先 as long
            for 列 = 2 to 5
                転記先 = worksheets(シート名).cells(rows.count,2).end(xlup).row + 1
                worksheets(シート名).cells(転記先,列)=.cells(処理行,列)
            next 列

            '昇順で並び替え
            with worksheets(シート名)
                .Range(.Cells(1, 1), .Cells(転記先, 6)).Sort
                    _key1:=.Cells(1, 2), Order1:=xlAscending,
                    _key2:=.Cells(1, 3), Order2:=xlAscending,
                    _key3:=.Cells(1, 6), Order3:=xlAscending, Header:=xlYes
            end with
        Next 処理行
    end with

    application.ScreenUpdating=true

end sub


明日からどうしようかな、と思っているんですが、
あ、そう言えば、マクロの実行について説明してなかった…
ので、実行とかデバッグ(イミディエイトウインドウやウォッチ式)について説明していきます。

今までのところでわからないことがあれば、コメントまで!w


にほんブログ村さんのランキングへ参加はじめました。
よろしければ、クリックで応援お願いします☆

にほんブログ村 IT技術ブログ VBAへ
にほんブログ村




ラベル:VBA 家計簿
posted by くま母 at 21:51| Comment(0) | ExcelVBA | このブログの読者になる | 更新情報をチェックする
この記事へのコメント
コメントを書く
コチラをクリックしてください
×

この広告は180日以上新しい記事の投稿がないブログに表示されております。