VBA 【コピペで使える！】シートの存在を確認してから削除や追加するコード！

どうもマサヤです！

今日は、VBAでシートの存在を確認してから削除や追加をするコードを紹介します。

再利用できるようにシート名を指定するだけで使えるようにしています。

「コード説明は不要だよ～サクッとコードだけ知りたい！」

そういうあなたは、目次の【これをコピペ！】・・・をクリックしてくださいね。

シートの存在確認はFor Eachは使わず、例外処理で！
例外処理を使ったシート存在確認のコード
- コードのポイント
【これをコピペ！】煩雑にしないため関数にしました
- シートの存在を確認するコード
- シートの削除・追加もしてくれるコード
まとめ

シートの存在確認はFor Eachは使わず、例外処理で！

下記コードのように、一般的なシートの存在確認はFor Eachを使い、全シートをループさせて目的シートがあるかを確認します。

Sub SheetExists()

Dim s As Worksheet
Dim find_name As String
Dim flg As Boolean

find_name = "Sheet1"

For Each s In ThisWorkbook.Worksheets
    If s.Name = find_name Then
        flg = True
        Exit For
    End If
Next

If flg = True Then 'Trueならシート存在している
    Debug.Print find_name & "は存在しています。"
End If

End Sub

これでも問題ありませんが、多数のシートがある場合ちょっと遅くなります。

そこで今回紹介するコードでは、例外処理の特性を使ってシートの存在確認をしています。

このコードであればピンポイントで目的シートの存在確認ができ無駄がありません。

例外処理を使ったシート存在確認のコード

例外処理を使ったコードはこちらです！

Sub SheetExists()

Dim wb As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook

On Error Resume Next
Set ws = wb.Worksheets("Sheet1") '←存在確認したいシートを指定
On Error GoTo 0

If Not ws Is Nothing Then 'Nothingならシートが存在しない
    Debug.Print ws.Name & "は存在しています"
End If

End Sub

この手法はStack OverflowでTim Williamsさんが紹介しているコードです。

コードのポイント

このコードのポイントは2つです。

①　On Error Resume Next を使うことで、set ws = wb.Worksheets(“Sheet1”) でエラーが発生しても、次のコードを実行させています。

②　Not ws in Nothingを使うことで、wsがNothing（存在していない）でも、エラーなく処理されるようにしています。

【これをコピペ！】煩雑にしないため関数にしました

上記のコードをメイン関数と同じにすると、例外処理が煩雑になります。

別で関数化したほうが間違いなく使いやすいので2パターンの関数を作成しました！

シートの存在確認だけするコード
追加や削除もしてくれるコード

お好きにコピペしてお使いください。

シートの存在を確認するコード

Function SheetExists(name As String) As Boolean

Dim wb As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook

On Error Resume Next
Set ws = wb.Worksheets(name)
On Error GoTo 0

SheetExists = Not ws Is Nothing

End Function

説明不要かと思いますが、下記コードにて実行できます。

flg = SheetExists("Sheet5") '　　←存在確認したいシートを指定

戻値がTrueならシートが存在している、 Falseならシートが存在していない。

シートの削除・追加もしてくれるコード

Sub SheetExistsToDeleteAndAdd(name As String)

Dim wb As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook

On Error Resume Next
Set ws = wb.Worksheets(name)
On Error GoTo 0

If Not ws Is Nothing Then 'Nothingならシートが存在しない
Application.DisplayAlerts = False
ws.Delete 'シート削除
Application.DisplayAlerts = True
End If

wb.Worksheets.Add(Worksheets(1)).name = name '一番手前にシート追加して、シート名を変更

End Sub

VBAを実行する度にシートの削除・作成（初期化に近い）をしたい場合に使えます。

あと、関数名がダサいのでアナタの好きな名前に変えてください）笑