[VBA]Excelのシート存在判定処理 決定版

はじめに

Excelを対象としたVBAにおいて「シートの存在判定」はありふれた処理であり、多くの人がそのための関数を作成・公開している。

しかし、「存在判定の正確性(GUI操作時のExcelと同じような判定をするか)」という観点で見た場合、多くの処理が何かしら考慮漏れがあり、「これぞ」というものが見つからなかった。

そのため自分なりに満足のいく処理を作成してみた。

190926追記
下記コードでも用途によっては不十分な場合があります。
詳しくはTwitterの以下のスレッドをご覧下さい。

これな・・・
Excelのあらゆるオブジェクトについて、存在を返すExists関数を常備してるわ。

ところで下記の2種類の方法には、どちらもNGなパターンがあるので注意しなければならないことを、先日知りました。 https://t.co/gmSgFkFmRC

— ことりちゅん@えくせるちゅんちゅん (@KotorinChunChun) September 26, 2019

シート存在判定関数

シート存在判定関数

'`inSheets`の中から、`inName`の名前のシートを探す。
'見つかった場合、`True`を返し、`outFindSheet`に見つかったシートオブジェクトを設定する。
'見つからなかった場合、`False`を返す(`outFindSheet`は変更されない)。

'引数
    'inSheets       :探索対象のシート群。`ThisWorkbook.Worksheets`などを指定する。
    'inName         :探索するシートの名前。
    'outFindSheet   :返り値用引数(参照渡し)。見つかったシート。As Excel.Worksheet | Excel.Chart | Excel.DialogSheet

'返り値
    '`inName`のシートが見つかった場合`True`、それ以外は`False`。

Public Function TryFindSheet( _
                       inSheets As Excel.Sheets, _
                       inName As String, _
        Optional ByRef outFindSheet As Object _
    ) As Boolean
    
    'Excelのシート名は、
    '半角全角・大文字小文字を同一視し、
    'ひらがなカタカナを異なるものと判断する。
    'VBAには同じ方法で文字列を比較する方法が無いため、
    '半角全角・大文字小文字をStrConvで揃えてからvbBinaryCompareで比較する。
    Dim convOption As VBA.VbStrConv
    convOption = vbNarrow Or vbUpperCase '半角大文字へ変換する。
    Const JP_LCID = 1041
    
    '引数の半角全角・大文字小文字を揃える。
    Dim argAsNarrowUpper As String
    argAsNarrowUpper = VBA.Strings.StrConv(inName, convOption, JP_LCID)
    
    Dim sht As Object 'As Excel.Worksheet | Excel.Chart | Excel.DialogSheet
    For Each sht In inSheets
        '各シートの名前の半角全角・大文字小文字を揃える。
        Dim tmpName As String
        tmpName = VBA.Strings.StrConv(sht.Name, convOption, JP_LCID)
        
        'vbBinaryCompareで文字列比較。
        If VBA.Strings.StrComp(argAsNarrowUpper, tmpName, vbBinaryCompare) = 0 Then
            '同じであれば見つかったと判断。
            Set outFindSheet = sht
            Let TryFindSheet = True
            Exit Function
        End If
    Next sht
    'return False
End Function

サンプル

Private Sub SampleOfTryFindSheet()
    Dim ss As Excel.Sheets
    Set ss = Workbooks.Add(XlWBATemplate.xlWBATWorksheet).Worksheets
    
    Dim ws As Excel.Worksheet
    Set ws = ss.Item(1)
    
    Dim findName As String
    Dim findSht As Excel.Worksheet
    
    ws.Name = "w"
    
    findName = "w"
    If TryFindSheet(ss, findName, findSht) Then
        Debug.Print "「"; findName; "」を指定して「"; findSht.Name; "」が見つかりました。"
    Else
        Debug.Print "「"; findName; "」を指定して「"; ws.Name; "」が見つかりませんでした。"
        ss.Add().Name = findName
    End If
    
    findName = "W"
    If TryFindSheet(ss, findName, findSht) Then
        Debug.Print "「"; findName; "」を指定して「"; findSht.Name; "」が見つかりました。"
    Else
        Debug.Print "「"; findName; "」を指定して「"; ws.Name; "」が見つかりませんでした。"
        ss.Add().Name = findName
    End If
    
    findName = "ｗ"
    If TryFindSheet(ss, findName, findSht) Then
        Debug.Print "「"; findName; "」を指定して「"; findSht.Name; "」が見つかりました。"
    Else
        Debug.Print "「"; findName; "」を指定して「"; ws.Name; "」が見つかりませんでした。"
        ss.Add().Name = findName
    End If
    
    findName = "Ｗ"
    If TryFindSheet(ss, findName, findSht) Then
        Debug.Print "「"; findName; "」を指定して「"; findSht.Name; "」が見つかりました。"
    Else
        Debug.Print "「"; findName; "」を指定して「"; ws.Name; "」が見つかりませんでした。"
        ss.Add().Name = findName
    End If
    
    
    ws.Name = "ア"
    
    findName = "ア"
    If TryFindSheet(ss, findName, findSht) Then
        Debug.Print "「"; findName; "」を指定して「"; findSht.Name; "」が見つかりました。"
    Else
        Debug.Print "「"; findName; "」を指定して「"; ws.Name; "」が見つかりませんでした。"
        ss.Add().Name = findName
    End If
    
    findName = "ｱ"
    If TryFindSheet(ss, findName, findSht) Then
        Debug.Print "「"; findName; "」を指定して「"; findSht.Name; "」が見つかりました。"
    Else
        Debug.Print "「"; findName; "」を指定して「"; ws.Name; "」が見つかりませんでした。"
        ss.Add().Name = findName
    End If
    
    findName = "あ"
    If TryFindSheet(ss, findName, findSht) Then
        Debug.Print "「"; findName; "」を指定して「"; findSht.Name; "」が見つかりました。"
    Else
        Debug.Print "「"; findName; "」を指定して「"; ws.Name; "」が見つかりませんでした。"
        ss.Add().Name = findName
    End If
    
End Sub

結果

「w」を指定して「w」が見つかりました。
「W」を指定して「w」が見つかりました。
「ｗ」を指定して「w」が見つかりました。
「Ｗ」を指定して「w」が見つかりました。
「ア」を指定して「ア」が見つかりました。
「ｱ」を指定して「ア」が見つかりました。
「あ」を指定して「ア」が見つかりませんでした。

2019年時点のExcelの仕様

Excelで既存のシートと同じ名前を別のシートに設定しようとすると、上記の「この名前は既に使用されています。別の名前を入力してください。」のダイアログが表示される。

このときExcelは以下のルールに則って名前を比較し判定しているようだ**(2019年の私個人による確認)**

文字の違い	シートの存在判定の動作
大文字小文字の違い	無視する
全角半角の違い	無視する
ひらがなカタカナの違い	考慮する

以下に例を挙げる。

例1:wというシートがすでにある場合

名前	種類	名前を設定出来るか
w	半角小文字	不可
W	半角大文字	不可
ｗ	全角小文字	不可
Ｗ	全角大文字	不可

→w・W・ｗ・Ｗは同じ文字だと判定される

例2:アというシートがすでにある場合

名前	種類	名前を設定出来るか
ア	全角カタカナ	不可
ｱ	半角カタカナ	不可
あ	ひらがな	可

→アとｱは同じ文字だと判定される

よくある処理の問題

単純比較

まずはもっともよく見るパターンを考えてみる。

NG1

Dim findName As String
findName = "シートの名前"

Dim existsSheet As Boolean

Dim sht As Object
For Each sht In ThisWorkbook.Sheets
    If sht.Name = findName Then
        existsSheet = True
        Exit For
    End If
Next sht

If existsSheet Then
'...

この処理の問題はsht.Name = findNameと単純に文字列比較していることである。

Excel上で動くVBAの文字列比較モードはデフォルトでOption Compare Binaryであり、大文字小文字・全角半角を区別して比較を行うモードとなる。

そのため、上記の処理では「存在しない」と判断されるケースが増えてしまう。

単純な文字列比較をするのであればOption Compare TextやStrCompにvbTextCompareを指定した方がExcelの動作に近くはなるが、こういった実装の例はほとんどみない(現実的には形式をしっかり整えていればOption Compare Binaryで十分だからだと思われる)。

Sheets.Itemでエラー判定

次にやや賛否はあるもののスマートとされている方法である。

Dim findName As String
findName = "シートの名前"

Dim existsSheet As Boolean

Dim ws As Excel.Worksheet
On Error Resume Next
    Set ws = ThisWorkbook.Worksheets.Item(findName)
    existsSheet = (Err.Number = 0)
On Error GoTo 0

If existsSheet Then
'...
End If

私個人としては、この処理は先ほどの「単純比較」より良い処理だと思っている(汎用化したこんな関数を作る程度には)。

ではこの処理の問題は何かというと、「全角半角を区別してしまう」というところである。
大文字小文字に関しては同一視してくれるのだが、日本語特有の「全角半角」までは対応していない。
英語圏でしか使われないのであればこの処理でも十分なことは多いと思われるが、日本語環境ではあと一歩足りず、ということになる。