VBA 新しいワークシートを追加する

Excel VBA 新しいワークシートを追加するサブ関数として作ります。

VBA sub関数「VBA 新しいワークシートを追加」の仕様
VBA sub関数「新しいワークシートを追加」のソース
VBA sub関数「新しいワークシートを追加」の実行
VBA sub関数「新しいワークシートを追加」のソース改修
改修後の関数のテスト
1. テストのための関数

VBA sub関数「VBA 新しいワークシートを追加」の仕様

Excel VBAで現在あるワークシートの最後に、新しいワークシートを名前を指定して追加後、その追加したワークシート開く（アクティブにする）プログラム
もし既に、同一名のワークシートが存在している場合は、新たに追加せずにそのワークシートを開く（アクティブにする）仕様で作ります。

VBA sub関数「新しいワークシートを追加」のソース

ソースの前半部分で、
同一名のワークシートが存在しているかチェック、
存在の有無フラグ SheetExistをセット、
存在していればそのワークシートをSelectメソッドでアクティブにします。
後半部分は、
同一名のワークシートが存在してなければ、
ワークシートの最後に新しいワークシートを追加
指定されたワークシート名に変更

ワークシートを追加した時点で、そのシートはアクティブになります。

ソースです。

'
' 指定した名前のワークシートを最後に追加
'   SheetName = 追加するワークシート名
'
Sub AddSheetLast(SheetName As String)
    Dim I As Integer
    Dim S As String
    Dim SheetExist As Boolean
    
    SheetExist = False
    
    For I = 1 To Worksheets.Count
        S = Worksheets(I).Name
        If S = SheetName Then
            ' 同一名のワークシート在り
            SheetExist = True
            Worksheets(I).Select
            Exit For
        End If
    Next
    
    If SheetExist = False Then
        ' 新しくワークシートを追加
        Sheets.Add After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = SheetName
    End If
    

End Sub

VBA sub関数「新しいワークシートを追加」の実行

作った関数を実行させる簡単なsub関数を用意しました。

Sub test()
   ' 「最後にシートを追加」というワークシートを最後に追加
    AddSheetLast ("最後にシートを追加")
End Sub

実行前

実行後

「最後にシートを追加」の名前のワークシートが最後に追加されました。

次は、
既に同一名のワークシートがある場合で検証を
実行前です

既に同一名のワークシートがある場合での実行後

新たなワークシートは作られず
指定した名前のワークシートが開かれました（アクティブに）

VBA sub関数「新しいワークシートを追加」のソース改修

ここで問題が発覚！！

Excelのワークシート名の特性

前項のソースで一見良さそうなのですが、

Excelのワークシート名は、

実は、アルファベット、数字に関しては、

全角、半角が同一視、更に

大文字、小文字も同一視

されます。

例として

「ワークシートＡ」（Ａは全角大文字）
「ワークシートａ」（ａは全角小文字）
「ワークシートA」（Aは半角大文字）
「ワークシートa」（aは半角小文字）

は、全て同一のワークシートを指してます。

関数は、sub改めfunctionに変更

関数中のワークシートの重複のチェックは、

比較するワークーシート名を各々半角小文字に変換して行うように変更します。

また、ワークシートが重複する場合は、そのワークシート名を知ることができると便利なので

sub関数「新しいワークシートを追加」は、ファンクションタイプとして、

戻り値を、ワークシート名するように改修します。

改修後のソース

Functionタイプの関数として戻り値として有効なワークシート名を返します。

' 指定した名前のワークシートを最後に追加
'   SheetName = 追加するワークシート名
'
' 【戻り値】有効なワークシート名
'
Function AddSheetLast(SheetName As String) As String
    Dim I As Integer
    Dim S As String
    Dim AddS As String
    Dim SheetExist As Boolean
    
    SheetExist = False
    ' 追加するワークシート名を半角小文字に変換
    AddS = StrConv(LCase(SheetName), vbNarrow)
    
    For I = 1 To Worksheets.Count
        S = Worksheets(I).Name
        If StrConv(LCase(S), vbNarrow) = AddS Then
            ' 同一名のワークシート在り
            SheetExist = True
            Worksheets(I).Select
            ' 重複元のワークシート名を返す
            AddSheetLast = S
            Exit For
        End If
    Next
    
    If SheetExist = False Then
        ' 新しくワークシートを追加
        Sheets.Add After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = SheetName
        ' 新たに追加したワークシート名を返す
        AddSheetLast = SheetName
    End If
End Function

改修後の関数のテスト

Sub改めFnctionとして作った関数の動作チェックをします。

テストのための関数

改修した関数でワークシート名を
「ワークシートＡ」（Ａは全角大文字）で実行
「ワークシートＢ」（Ｂは全角大文字）で実行
「ワークシートa」（aは半角小文字）で実行
させます。
ソースは、

Sub Test()
    Dim S As String

    S = AddSheetLast("ワークシートＡ")
    Debug.Print S
    
    S = AddSheetLast("ワークシートＢ")
    Debug.Print S
    
    S = AddSheetLast("ワークシートa")
    Debug.Print S
End Sub

実行後のデバッグ出力は
ワークシートＡ
ワークシートＢ
ワークシートＡ

Excelのブックは、

で

「ワークシートa」（aは半角小文字）は

「ワークシートＡ」（Ａは全角大文字）と同一判定で

「ワークシートＡ」がアクティブになってます。