和風スパゲティのレシピ

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

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

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

Worksheets.Add
ActiveSheet.Name = Worksheets("売上データ").Range("A1")

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


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


重複したシート名

こんな風に勝手になってくれたらいいんですけどね。
残念ながらこれを自動ではやってくれません。


この「シート名が重複した場合は連番をつける」方法ですが、
まずはコーディング時間のコスパが良い解決策がこちらです。

Dim 作成シート As Worksheet
Set 作成シート = Worksheets.Add
Dim シート名 As String
シート名 = Worksheets("売上データ").Range("A1")

' エラーをスキップする設定でとりあえず名付けてみる
On Error Resume Next
作成シート.Name = シート名

' スキップされしまった(目的の名前になっていない)なら、(2)をつけてもう一回トライ
If 作成シート.Name <> シート名 Then
    作成シート.Name = シート名 & " (2)"
End If

' エラーをスキップする設定を元に戻す(これを忘れないように!)
On Error GoTo 0

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


もちろんこのマクロでは3つかぶった場合にシート名が変わらないのですが、
商品にして売るマクロでもなければ、この程度で済ませて

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

と、適度に手入力とマクロをハイブリットに使っていくのも、
コーディングコストを抑えるのには重要なテクニックです。


プログラムって、

だいたい動くコードは30分で作れた。
 ⇒ レアケースのエラー対応に3時間かかった。

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

この方法で十分!という方はこちらをお使いください。


「どうしても(3)、(4)…と完璧に処理したい」という方は、
以下のコードと解説にお進みください。

連番付きでシート名を設定する関数を作る

さて「シート名が重複した場合は重複がなくなるまで(3)、(4)…と増やして連番をつける」コードですが、たかがシート名を変えるだけなのに、結構なコード量になります。

これをいちいちメインマクロに書くと、もっと重要な処理が読みづらくなるため、

Dim 作成シート As Worksheet
Set 作成シート = Worksheets.Add
Dim シート名 As String
シート名 = Worksheets("売上データ").Range("A1")

Call 重複とエラーを回避したシート名を設定する(作成シート, シート名)

↑このように、「名称を設定したいシート」と「設定するシート名」を渡すと、
シート名が被った場合は連番をつけた上で名付けてくれる関数
を作ります。

関数にすると、メインマクロ上では1行で済むようになり、コードが格段に読みやすくなりますし、使いまわしもできるようになりますからね。


今回の目的さえ果たせばいいという方は、
関数だけコピペしたら中身を見ずに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と触れ合っていきましょう。