ブックに指定のシートがあれば、そのシートを開き、なければシートを作成する
指定したシートがあるかどうか？確認しましょう！
ファイル構成
月別にシートを作成します
ファイル選択：年月を指定するシート
家計簿ひな型：作成するシートのひな型
項目マスタ―：マスタデータ
各月シート ：1～12月
例題として、家計簿を作成します
売上データ・請求書・工程表など月毎シートを作成する処理に応用してください
年月の指定
年・月はファイル選択シートで入力します
Dim Nen As Long ’作成する家計簿の年
Dim Tuki As Long ‘作成する家計簿の月
Dim Tuki_Name As String ’作成する月のシート名
Nen = Worksheets(“ファイル選択”).Range(“d5”)
Tuki = Worksheets(“ファイル選択”).Range(“d7”)
Tuki_Name = Tuki & “月” ’作成する月のシート名(“1月”等)
コレクション
オブジェクトとは…「もの」 ワークブック、ワークシート、セル等
コレクションとは…
コレクションなのでｓを付けるんだね
Worksheetsコレクションは、シートの数だけオブジェクトがある！
For Eachステートメント
For Eachは、コレクションの各要素に対して、繰り返し処理を実行する
コレクションの中からオブジェクトを１つずつ取り出し、コレクションが
なくなったら処理を終える
オブジェクト変数
オブジェクト変数にオブジェクトを代入するときは、Setが必要
Set WS = Worksheets(“Sheet1”)
シートがあるかどうかの判断
PartⅠ
For Eachで
Worksheetsコレクションの中からシートを取り出し、
同じシート名であれば、
SWを１にして、For Eachを抜ける
Sub 家計簿作成シート追加1()
Dim Nen As Long '作成する家計簿の年
Dim Tuki As Long '作成する家計簿の月
Dim Tuki_Name As String '作成する月のシート名("1月"等)
Dim WS As Worksheet 'ワークシートを表す変数
Dim SW As Long 'スイッチ(ﾜｰｸｼｰﾄがあるか？の判断に使う)
Nen = Worksheets("ファイル選択").Range("d5")
Tuki = Worksheets("ファイル選択").Range("d7")
Tuki_Name = Tuki & "月" '作成する家計簿の月のシート名
'指定した月のシートがあるかどうか Part1
SW = 0 'スイッチの初期値
For Each WS In Worksheets 'ワークシートの数だけループ
'取り出したワークシートの名前がTuki_Nameの時
If WS.Name = Tuki_Name Then SW = 1: Exit For
Next WS 'For Eachの終わり
指定する月のシートがある場合は、シートをアクティブに！
Worksheets(Tuki_Name).Activate
シートの追加
指定する月のシートがない場合は、Worksheets.Addを使います
まっさらなシートが追加されます
今回は、ひな型(見出し・罫線・計算式等の入ったもの)をCopyして、新しいシートとする
一番最後(Worksheets(Worksheets.Count))のafterに作成する
Worksheets(“家計簿ひな形”).Copy after:=Worksheets(Worksheets.Count)
これが実行されるとWorksheets.Countは+１される
作成したシート名Worksheets(Worksheets.Count)のシート名を変更
Worksheets(Worksheets.Count)は、最後に作成したシート（ひな形のコピー)
シート名の変更
If SW = 0 Then 'ワークシートがない時
'家計簿ひな形シートを末尾にコピー
Worksheets("家計簿ひな形").Copy after:=Worksheets(Worksheets.Count)
'ワークシート名を指定月に!
Worksheets(Worksheets.Count).Name = Tuki_Name
Range("m1") = Nen
Range("h1") = Tuki
Else 'ワークシートがある時
Worksheets(Tuki_Name).Activate '指定月のシートをアクティブに！
End IfPartⅡ
On Error Resume Nextを用いる
シートがあってもなくても、Set WS = Worksheets(Tuki_Name)を指定する
指定シートがなければ、この時点でErrorとなるが、
On Error Resume Nextとしているので、Errorにならず先に進む
Set WS = Worksheets(Tuki_Name)
指定したシートがあれば、オブジェクト変数WSに指定シートが代入される
指定したシートがなけば、オブジェクト変数WSはNothingのまま
Nothing：オブジェクト変数の参照がない（オブジェクト変数の初期値）
Dim WS As Worksheet 'ワークシートを表す変数
On Error Resume Next 'エラーが発生しても、次に進む
Set WS = Worksheets(Tuki_Name) 'シート名をワークシート型変数に代入Nothingでないとき
指定する月のシートがある場合は、シートをアクティブに！
Worksheets(Tuki_Name).Activate
Nothingのとき
指定する月のシートがない場合は、ひな型をCopyして、シート名を指定月とする
Worksheets(“家計簿ひな形”).Copy after:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = Tuki_Name
エラー処理を戻す
On Error GoTo 0 をお忘れなく！
If WS Is Nothing Then 'WSがNothingの時(シートがない時）
'家計簿ひな形シートを末尾にコピー
Worksheets("家計簿ひな形").Copy after:=Worksheets(Worksheets.Count)
'ワークシート名を指定月に!
Worksheets(Worksheets.Count).Name = Tuki_Name
Worksheets(Tuki_Name).Range("m1") = Nen
Worksheets(Tuki_Name).Range("h1") = Tuki
Else 'ワークシートがある時
Worksheets(Tuki_Name).Activate '指定月のシートをアクティブに！
End If
On Error GoTo 0 '通常のエラー処理に戻す
プログラムソース
Sub 家計簿作成シート追加1()
Dim Nen As Long '作成する家計簿の年
Dim Tuki As Long '作成する家計簿の月
Dim Tuki_Name As String '作成する月のシート名("1月"等)
Dim WS As Worksheet 'ワークシートを表す変数
Dim SW As Long 'スイッチ(ﾜｰｸｼｰﾄがあるか？の判断に使う)
Nen = Worksheets("ファイル選択").Range("d5")
Tuki = Worksheets("ファイル選択").Range("d7")
Tuki_Name = Tuki & "月" '作成する家計簿の月のシート名
'指定した月のシートがあるかどうか Part1
SW = 0 'スイッチの初期値
For Each WS In Worksheets 'ワークシートの数だけループ
'取り出したワークシートの名前がTuki_Nameの時
If WS.Name = Tuki_Name Then SW = 1: Exit For
Next WS 'For Eachの終わり
If SW = 0 Then 'ワークシートがない時
'家計簿ひな形シートを末尾にコピー
Worksheets("家計簿ひな形").Copy after:=Worksheets(Worksheets.Count)
'ワークシート名を指定月に!
Worksheets(Worksheets.Count).Name = Tuki_Name
Range("m1") = Nen
Range("h1") = Tuki
Else 'ワークシートがある時
Worksheets(Tuki_Name).Activate '指定月のシートをアクティブに！
End If
End SubSub 家計簿作成シート追加2()
Dim Nen As Long '作成する家計簿の年
Dim Tuki As Long '作成する家計簿の月
Dim Tuki_Name As String '作成する月のシート名("1月"等)
Dim Tuki_Name As String '作成する月のシート名("1月"等)
Dim WS As Worksheet 'ワークシートを表す変数
Nen = Worksheets("ファイル選択").Range("d5")
Tuki = Worksheets("ファイル選択").Range("d7")
Tuki_Name = Tuki & "月" '作成する家計簿の月のシート名
'指定した月のシートがあるかどうか Part２
On Error Resume Next 'エラーが発生しても、次に進む
Set WS = Worksheets(Tuki_Name) 'シート名をワークシート型変数に代入
If WS Is Nothing Then 'WSがNothingの時(シートがない時）
'家計簿ひな形シートを末尾にコピー
Worksheets("家計簿ひな形").Copy after:=Worksheets(Worksheets.Count)
'ワークシート名を指定月に!
Worksheets(Worksheets.Count).Name = Tuki_Name
Worksheets(Tuki_Name).Range("m1") = Nen
Worksheets(Tuki_Name).Range("h1") = Tuki
Else 'ワークシートがある時
Worksheets(Tuki_Name).Activate '指定月のシートをアクティブに！
End If
On Error GoTo 0 '通常のエラー処理に戻す
End Sub
コメント