VBA ユニークなワークシート名を算出する

はじめに

新しいワークシートを作成する業務は多く、それらに適切な名前をつける要件もたくさんあります。

ワークシートの命名はワークブック内でユニークである必要があり、それらを算出することもしばしばあるので汎用化しました。

このようなスニペットは既にたくさんありそうですが、探してもパッと出てこなかったので自分の要件に合わせて作りました。

スニペット

' -----
' 命名のために、既存のものと重複しないワークシート名称を返す。
' 引数  :basename               ワークシート名称の基準となる名前。文字列。
'       :ws                     命名しようとしているワークシート。
'       :fmt                    連番を振る際のフォーマット。
' 返値  :重複しないワークシート名称。
' https://qiita.com/Tachy_Pochy/items/25f69edc8ba8094b8ecc
' -----
Public Function UniqueSheetName(ByVal basename As String, _
                                ByRef ws As Worksheet, _
                                Optional fmt As String = " (0)") As String
    Dim wb As Workbook
    Set wb = ws.Parent

    Dim ret As String
    ret = basename

    Dim seq As Integer
    seq = 1

    Dim duplicate As Boolean
    Dim i As Integer
    Do
        duplicate = False
        For i = 1 To ActiveWorkbook.Sheets.Count
            If ws.Index <> i Then
                If UCase(wb.Sheets(i).Name) = UCase(ret) Then
                    duplicate = True
                    Exit For
                End If
            End If
        Next
        If duplicate Then
            ret = basename & Format(seq, fmt)
            seq = seq + 1
        End If
    Loop While duplicate

    UniqueSheetName = ret
End Function