シートの追加

YouTube VBA

ブックに指定のシートがあれば、そのシートを開き、なければシートを作成する
指定したシートがあるかどうか?確認しましょう!

ファイル構成

月別にシートを作成します

ファイル選択:年月を指定するシート
家計簿ひな型:作成するシートのひな型
項目マスタ―:マスタデータ
各月シート :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は、コレクションの各要素に対して、繰り返し処理を実行する
コレクションの中からオブジェクトを1つずつ取り出し、コレクションが
なくなったら処理を終える  
                   

オブジェクト変数

オブジェクト変数オブジェクトを代入するときは、Setが必要
Set WS = Worksheets(“Sheet1”)

シートがあるかどうかの判断

PartⅠ

For Each
Worksheetsコレクションの中からシートを取り出し、
同じシート名であれば、
SWを1にして、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は+1される

作成したシート名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 If

PartⅡ

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 Sub
Sub 家計簿作成シート追加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 & "月"         '作成する家計簿の月のシート名
  
    '指定した月のシートがあるかどうか Part2
    
    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

コメント