[[20201113181347]]　『シート名が重複した場合連番を付けエラー回避した』（PK）　ページの最後に飛ぶ

『シート名が重複した場合連番を付けエラー回避したい』（PK）

特定のセルの内容をシート名にしたく、以下のVBAを使用していますが
セルの内容が重複した場合エラーになってしまいます。
重複する場合には連番を振りエラーを回避したいのですが
どのような文を追記すれば良いのでしょうか？
宜しくお願い致します。

Sub セルをシート名にする()

    Dim msheet As Worksheet
    For Each msheet In Worksheets
        msheet.Name = msheet.Range("A2").Value
    Next
End Sub

＜使用 Excel：Office365、使用 OS：Windows10 ＞

参考過去ログです。

[[20201105155840]]　『マクロ　新しいシートを作って同じ名前なら後ろに』（はぁ～と）
（OK） 2020/11/13(金) 18:44

OK様

ありがとうございます。
ご案内いただいたログを確認しました。
この方は以下で稼働したとのことですが、
どこでセルの値を指定すれば良いのでしょうか？
初心者で理解が難しいためお手数ですが再度ご教示ください。

 Sub ChangeSheetName(WS As Worksheet, ByVal newName As String)
    Dim i As Integer, n As Integer
    Dim oWS As Worksheet
    n = 1
    On Error GoTo Err_NewName
       WS.Name = newName
    On Error GoTo 0
    Exit Sub
Err_NewName:
       If n > 99 Then Err.Raise Err.Number, , Err.Description
       Set oWS = WS.Parent.Worksheets(newName)
       If oWS.Name Like "*(?)" Or WS.Name Like "*(??)" Then
          i = InStrRev(oWS.Name, "(")
          n = Val(Mid(oWS.Name, i + 1)) + 1
          newName = Left(oWS.Name, i) & n & ")"
       Else
          n = n + 1
          newName = newName & Format(n, "(0)")
       End If
       Resume
 End Sub

（PK） 2020/11/13(金) 19:02

同じシート名が既に存在するか少し乱暴なやり方ですが
チェックし、無くなるまで繰り返してみました。

Sub セルをシート名にする()

    Dim msheet As Worksheet
    Dim ws As Worksheet
    Dim n As String     'シート名用文字列
    Dim n2 As String    '連番文字
    Dim i As Long       '連番用

    For Each msheet In Worksheets
        '変数の初期化
        n = msheet.Range("A2").Value
        n2 = ""

        '仮に変数に名前を指定してシートを代入してみる
        'もしあればすんなり代入されなければ(エラーで無視される）Nothingのまま
        On Error Resume Next
        Set ws = Worksheets(n)
        On Error GoTo 0

        '変数wsにシートが代入されなくなるまで繰り返し
        Do Until ws Is Nothing
            i = i + 1           '連番カウントアップ
            n2 = "(" & i & ")"  '連番文字生成

            'シート名に連番を付けて変数に代入してみる
            Set ws = Nothing
            On Error Resume Next
            Set ws = Worksheets(n & n2)
            On Error GoTo 0
        Loop

        msheet.Name = n & n2
    Next
End Sub

シート名を事前に関係ない名前にマクロで変更しておいた方がよいかも知れません。
何回も実行すると、ころころシート名が変わるので。
（まっつわん） 2020/11/13(金) 19:46

 他のプロシージャから下のようにして呼んで使います。

 Sub test()
  Dim ws As Worksheet
   For Each ws In Worksheets
    ChangeSheetName ws, ws.Range("b4").Value
   Next ws
 End Sub
（OK） 2020/11/13(金) 20:19

 PKさんの元のコードに組み込むとこんな感じです。

 Sub セルをシート名にする2()

     Dim msheet As Worksheet
     For Each msheet In Worksheets
         'msheet.Name = msheet.Range("A2").Value
         ChangeSheetName msheet, msheet.Range("A2").Value
     Next
 End Sub
（OK） 2020/11/13(金) 20:21

コメント返信：

[ 一覧(最新更新順) ]

[[20201113181347]] 『シート名が重複した場合連番を付けエラー回避した』（PK） ページの最後に飛ぶ

[[20201113181347]]　『シート名が重複した場合連番を付けエラー回避した』（PK）　ページの最後に飛ぶ