はじめに
Excelでシートをコピーした場合、シート名は「Sheet1（２）」といった具合に連番付きのシート名を生成してくれます。
今回は、これをプログラムで再現してみたいと思います。
あるシートの名前を変更したい時、他のシート名と名前が重複してしまうとエラーとなります。これを防ぐにはブック内のシート名を巡回して新たな名前が存在しているかを確認すれば良いでしょう。
また、もし同じシート名がある場合は、（２）を付加した連番付きのシート名にして存在しないシート名を付けるようにします。
シート名に同じものが無いかチェックするプログラム
まずは、同じシート名が無いかチェックするプログラムを書きます。
このプログラムでは、シート名を引数に渡すと、存在している場合はTrue、存在しない場合はFasle を返してくれます。
'シート名に同じものが無いかチェック
Function CheckSheetName(str As String) As Boolean
Dim b As Boolean
b = False
Dim sh
For Each sh In Worksheets
If sh.name = str Then
b = True
Exit For
End If
Next sh
CheckSheetName = b
End Function動作としては、ブック内にあるシート Worksheets からシートを取り出して名前を確認し、もしあればフラグ（変数 b） をTrueにしています。無い場合は、初期値のFalseが返ります。
重複しないシート名を生成する
上記のチェックプログラムを利用して重複しないシート名を生成する例を示します。
今回は、「Sheet1」シートを原本にして、「”日報”+日付」という形式でシート名を生成するようにします。もし、同じ日付の日報シートがあれば連番を付けて重複しないシート名を生成します。
'重複しないシート名を生成する
Sub sheetCopyTest()
Dim str As String, name As String, d As Long
Worksheets("Sheet1").Copy after:=Worksheets(Worksheets.Count)
name = "日報" & Format(Date, "yyyymmdd")
str = name
d = 2
Do While CheckSheetName(str)
str = name & "(" & d & ")"
d = d + 1
Loop
ActiveSheet.name = str
End Sub 最初のシート名はDateを使って年月日の形式で作っています。その後、先程の作った CheckSheetName に渡して重複を調査し、もし重複していれば連番を付けて再度調査します。
重複が無くなったら新しいシート名をセットします。
まとめ
今回のプログラムは、自分でシート名を生成していきたい場合に利用できるかと思います。
また、シート名に同じものが無いかチェックするプログラムを利用すれば、事前に重複するシート名を判別できるので、エラーメッセージを出して終了する事も可能です。
活用してみてください。
コメント