【VBA】同名のワークシート有無を確認して追加する

こんにちは、Ryoです。
ワークシートの追加自体はAddメソッドを利用することで簡単に処理できますが、元よりシートが多いブックや追加等でシート数が増えてきたりすると名前の重複をチェックした上で追加したいこともありますので、今回はその内容について書いていきます。

1.サンプル概要
2.サンプルコード
3.まとめ

1.サンプル概要

適当な名前を付けたワークシートを準備していますので、ここにシート名の重複をチェックしながら追加します。

追加するシート名をインプットボックスに入力します。ここではSheet1と入力して実行します。

シート名が重複しているので警告メッセージを表示してシートの追加を中止します。

次に同名ですが大文字／小文字の違いでシート名を入力して実行してみます。

シート名は大文字／小文字を区別されないので重複ありと判定されます。ちなみに片仮名文字の全角／半角は区別されます。

シート名が重複しない場合は最後尾に設定した名前で追加されます。

以上がサンプル概要になります。

2.サンプルコード

Sub Sample1()

  Dim flg As Boolean
  Dim wshName As String
  
  '画面更新処理を停止
  Application.ScreenUpdating = False
  
  'エラー処理を開始
  '（エラー発生時に停止しない為の処理）
  On Error Resume Next
  
  'インプットボックスでシート名の入力
  wshName = InputBox("追加するシート名を入力してください。")
  
  If wshName = "" Then
     'インプットボックス未入力時は終了
     Exit Sub
   Else
      'ワークシートを追加、入力されたワークシート名を設定
     Worksheets.Add.Name = wshName
  End If
  
  'エラー発生有無のチェック
  If Err.Number <> 0 Then
     'エラー発生（＝シート名重複）の場合はTrue
     flg = True
   Else
     'エラーなし（＝シート名重複なし）はFalse
     flg = False
  End If
  'エラー処理を終了
  On Error GoTo 0
  
  With Application
    '警告メッセージの非表示化
     .DisplayAlerts = False
     'シート名重複有無の確認
     If flg Then
       '重複時は追加したワークシートを削除
        ActiveSheet.Delete
        MsgBox "ワークシート " & wshName & _
        " は存在しますので追加できません。", vbCritical
      Else
      '重複していない場合はシート末尾に追加
       Worksheets(wshName).Move _
       After:=Worksheets(Worksheets.Count)
        MsgBox "ワークシート " & wshName & _
        " は存在しませんので末尾に追加します。", vbInformation
     End If
     '警告メッセージ非表示化解除
     .DisplayAlerts = True
     '画面更新処理再開
     .ScreenUpdating = True
  End With
  
End Sub

ワークシート名の取得と設定にはNameプロパティを利用します。

構文：オブジェクト.Name = expression

Nameプロパティを利用するとワークシート名の取得・設定が可能ですが制限として半角31文字（全角15文字）以内、「：」「？」「/」「￥」「[」「]」は利用不可、同名（大文字小文字区別なし）は使用不可という点があります。

サンプルコードではワークシート名の重複有無について「名前を設定したワークシートを追加した際に発生するエラー有無」でチェックしています。

エラーが発生すると処理が中断されてしまうので、その対処としてOn Errorステートメントを利用し、Addメソッドによりワークシートを追加した際のエラー発生状況を If Err.Number <> 0 でチェックして重複有無に応じた処理とメッセージ表示を行っています。

重複している場合は追加したシートの削除を行い、重複していない場合は最後尾に追加する形になります。