和風スパゲティのレシピ

日本語でコーディングするExcelVBA

重複しないよう連番付きでシート名を設定する

セルの値などを使って、シート名を機械的につけるマクロを組むこともよくあります。

' 商品ごとに帳票シートを出力する
Dim 作成シート As Worksheet
Set 作成シート = Worksheets.Add
作成シート.Name = Worksheets("売上データ").Cells(R, 2)

みたいなイメージでしょうか。


しかし、このシートの名称設定は、すでに使われているシート名を指定するとエラーになってしまいます。


重複したシート名

こんな風に勝手になってくれたらいいんですけどね。


この対策としては、

Dim シート名 As String
シート名 = Worksheets("売上データ").Cells(R, 2)

On Error Resume Next
作成シート.Name = シート名
If 作成シート.Name <> シート名 Then
    作成シート.Name = シート名 & "(2)"
End If
On Error GoTo 0

こんな風に、On Error Resume Nextでエラーをスキップし、
シート名が変わっていなければ(2)をつけてもう一回!
とやるのが楽です。


商品にして売るマクロでもなければ、この程度で済ませて

「まあ3つ被ったら手で直すか(´∀`)」

と、適度に手入力とマクロをハイブリットに使えると、
余計なコーディングコストがかからなくていいです。


プログラムって、

だいたい動くコードは30分で作れた。
 ⇒ 例外処理に2時間かかった。

みたいなことが往々にしてありますからね(笑)


ただ、どうしても(3)、(4)…とやる必要がある方のために、
それをきっちり実行するコードを紹介します。

実行例

今回のコードは(無駄に)長いコードになってしまうため、

Dim 作成シート As Worksheet
Set 作成シート = Worksheets.Add
Call 重複とエラーを回避したシート名を設定する(作成シート, Worksheets("売上データ").Cells(R, 2))

↑このように、「変更するシート」と「シート名」を渡すと、
シート名が被った場合は連番をつけて名付けてくれる関数にしました。


この手の「メインの処理ではないのに長くなるコード」をメインコードに書くと、
本当に重要な処理がわかんなくなっちゃいますからね。


今回の目的(重複した場合はシート名に連番を付与)さえ果たせばいいという人は、
関数だけコピペしたら中身を見ずにCallして使ってもOKです。


それができるというのも、関数化の大事なメリットですからね。

私とチーム開発して、私が担当した関数を使うようなイメージです。


ちゃんと中のコードも理解したいという方は、せっかくなので関数化も合わせて勉強してください。

この手の「細部までこだわるコード」を書くレベルに到達したのに、
SubやFunctionを分けずにやってるといずれ地獄を見ますので…


ではいきますね。

ソースコード

Sub 重複とエラーを回避したシート名を設定する(指定シート As Worksheet, ByVal 設定シート名 As String)
    On Error Resume Next

    ' ◇ 既に設定名であればExit
    If 指定シート.Name = 設定シート名 Then: Exit Sub

    ' 禁則文字を削除し31文字内に
    設定シート名 = シート名禁則文字を削除(設定シート名)
    設定シート名 = Left(設定シート名, 31)

    ' ◇ 既存シート名と重複した場合は連番を付与
    If Isシートが存在する(設定シート名, 指定シート.Parent) Then
    
        設定シート名 = Left(設定シート名, 27) ' 連番用の文字数を確保
        Dim i As Long: i = 2
        Do While Isシートが存在する(設定シート名 & " (" & i & ")", 指定シート.Parent)
            i = i + 1
        Loop
        設定シート名 = 設定シート名 & " (" & i & ")"
        
    End If
    
    ' 作成したシート名を設定
    指定シート.Name = 設定シート名

End Sub

Function シート名禁則文字を削除(ByVal 元テキスト As String) As String
    Dim Arr禁則文字リスト
    Arr禁則文字リスト = Split("',’,',*,:,?,\,¥,*,/,:,?,[,[,],],\,/,<,>", ",")
    Dim 禁則文字
    For Each 禁則文字 In Arr禁則文字リスト
        元テキスト = Replace(元テキスト, 禁則文字, "")
    Next
    シート名禁則文字を削除 = 元テキスト
End Function

Function Isシートが存在する(判定シート名 As String, 指定ブック As Workbook) As Boolean
    Dim ws As Worksheet
    For Each ws In 指定ブック.Worksheets
        If ws.Name = 判定シート名 Then
            Isシートが存在する = True
            Exit Function
        End If
    Next
End Function

解説

コード自体は基本的なものの組み合わせなので、
1行1行はよく読めば理解できると思います。

せっかく関数にパッケージ化するのであれば、シート名の重複以外に、
「31文字制限」と「禁則文字のチェック」も行ってしまいましょう。


このコードを実現するには、

  1. 重複がなくなるまで連番を増やしていくループ
  2. 同名シートがあるか調べるためにすべてのシートをループ
  3. すべての使用禁止文字をループしてReplace

と、3つのループが必要になるのですが、これらをそれぞれ別の関数として作っています。


特に2のループは1のループ中で実行されるため、同じところに書くとループが入れ子になって、無駄にコードが複雑化する恐れがありますからね。


「ループごとに関数化」は、コードをスッキリさせるために重要な手法です。

この機会に、覚えてしまってください。

おまけ:画期的?な方法

今回の処理は、実はループをまったく使わずに実装することもできます。

というか、なんと条件分岐すら使わずに実装できます。


シート名を○○から△△に変える場合の、その方法がこちら↓

Dim シートの元の位置 As Long
シートの元の位置 = Worksheets("○○").Index

Worksheets("○○").Move
ActiveSheet.Name = "△△"

ActiveSheet.Move Before:= Thisworkbook.Sheets(シートの元の位置)

コードも超短いですね。

一旦新しいブックに移してから名前を変えて、再度元の位置に戻しているだけです。


冒頭で、

重複したシート名

こうなってくれればいいのにといった、これをExcelにやらせる方法です。


Excelさんは、そのブック内で重複した名前をつけるとエラーで怒りますが、
他のブックからやってきたシートが重複している場合は連番をつけます

これを利用しているわけですね。


実際のところは、

  • 新規のブックを作っては消し、作っては消しで遅い
  • ブックを消すコードが「ただ1つのシートがMoveでいなくなる」なのが怖い
  • 実際に大量にこのコードを回すと、幽霊VBProjectが残ったり、メモリが足りないと怒られる

というデメリットがありますので、普通に↑で紹介した関数を使ってください。

まあネタ的なものですね(´∀`)


ただ、割とまじめな話、ゴリゴリコードを書かずにExcelさんにやってもらう方法が無いか考えるのも、ExcelVBAではかなり重要です。

プログラミングばっかりやりすぎて、視野が狭くなってしまわないよう、
柔軟な思考でExcelと触れ合っていきましょう。