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
明日からどうしようかな、と思っているんですが、
あ、そう言えば、マクロの実行について説明してなかった…
ので、実行とかデバッグ（イミディエイトウインドウやウォッチ式）について説明していきます。
今までのところでわからないことがあれば、コメントまで！ｗ
にほんブログ村さんのランキングへ参加はじめました。
よろしければ、クリックで応援お願いします☆
にほんブログ村
