sub タイトル()
dim 最終行 as long, 処理行 as long
dim 日付 as date
最終行=cells(rows.count,2).end(xlup).row
for 処理行=3 to 最終行
'ここに順繰り回してどうすのかという指示文を入力します
日付=cells(処理行,2).value
'フォーマットシートのコピー
worksheets("フォーマット").copy after:=worksheets("フォーマット")
activesheet.name = year(日付) & "年" & month(日付) & "月"
Next 処理行
end sub
それでは、予告通り「すでに該当月のシートが存在する場合は、シート作成をしない」という条件を加えていきます。
すでに該当月のシートが存在する場合の確認方法は、ファイル内に存在するシート名を1つずつ、
変更後のシート名と同じものがないか確認していきます。
for each シート in thisbook.worksheets
next シート
の構文で、シートを1つずつ見ていくことができます。
もし、同じシート名があれば、フラグを立てておき、後でシートを作成する日付か否かを判断させます。
（あらかじめ、フラグをfalseに設定しておく必要があります）
flag=false
if シート.name = year(日付) & "年" & month(日付) & "月" then
flag=true
end if
この2つを合わせると、
for each シート in thisbook.worksheets
flag=false
if シート.name = year(日付) & "年" & month(日付) & "月" then
flag=true
exit for
end if
next シート
'もし、フラグが立っていたら、シートを作成する
フラグを立てた後は、残っているシートを見続ける意味がないので、
for～Nextの繰り返し処理を抜けましょう。
データ量が多いときは、処理スピードが上がります。
今回、追加で作った箱があるので、宣言もしておきましょう。
sub タイトル()
dim 最終行 as long, 処理行 as long
dim 日付 as date
dim シート as worksheet
Dim flag As Boolean
最終行=cells(rows.count,2).end(xlup).row
for 処理行=3 to 最終行
'ここに順繰り回してどうすのかという指示文を入力します
日付=cells(処理行,2).value
'日付に合致する月のシートがあるか確認する
for each シート in thisbook.worksheets
flag=false
if シート.name = year(日付) & "年" & month(日付) & "月" then
flag=true
exit for
end if
next シート
'もし、フラグが立っていたら、シートを作成する
'フォーマットシートのコピー
worksheets("フォーマット").copy after:=worksheets("フォーマット")
activesheet.name = year(日付) & "年" & month(日付) & "月"
Next 処理行
end sub
さて、明日はいよいよ、入力データを該当月のシートに移動させます。
にほんブログ村さんのランキングへ参加はじめました。
よろしければ、クリックで応援お願いします☆
にほんブログ村
