Excel VBA シート名変更時、重複していたら連番を付けたい

質問

VBAで下記のように変数を使用しシート名の変更をしたいと考えています。

ActiveSheet.Name = nen & "." & getsu

nenには年が、getsuには月が入っていて、2009.12のような名前にするつもりです。
ただ、既に同じブック内に同じ名前のシートが存在する場合、
2009.12(2)のように、普通にシートをコピーしたときにつく連番と同じように、
自動的に連番をつけたいと考えているのですが、よい方法が分かりません。
なお、2009.12と2009.12(2)があれば、2009.12(3)となるように、
イメージとしては()の数字が同名のシートの数分増えるようにしたいと思っています。
なにとぞご教授いただけますでしょうか？

回答No.5

kybo

エラーなしでシンプルな方法です。

Sub macro()
Dim nen As Integer
Dim getsu As Integer
Dim W As Workbook
nen = 2009
getsu = 12
Set W = ActiveWorkbook
ActiveSheet.Move
ActiveSheet.Name = nen & "." & getsu
ActiveSheet.Move after:=W.Worksheets(W.Worksheets.Count)
End Sub

回答No.4

Wendy02

こんにちは。

>Excel VBA　シート名変更時、重複していたら連番を付けたい
こうすればよいのでは？

>2009.12と2009.12(2)があれば、2009.12(3)となるように、
ということですから、　　i = 2 '枝番初期値　というように、2にしてあります。
'-------------------------------------------

Sub SheetChangeName()
　　Const nen As String = 2009
　　Const getsu As String = 12
　　Dim i As Long
　　i = 2 '枝番初期値
　　On Error Resume Next
　　Do
　　　　Err.Clear
　　　　ActiveSheet.Name = nen & "." & getsu & "(" & CStr(i) & ")"
　　　　i = i + 1
　　Loop Until Err.Number = 0
　　On Error GoTo 0
End Sub

回答No.3

hige_082

こんな感じで

Sub test()
Dim nen, getsu
Dim eda As String
Dim i As Integer, j As Integer

nen = 2009
getsu = 12

eda = ""
j = 0
Do
eda = IIf(j = 0, "", "(" & j & ")")
For i = 1 To Worksheets.Count
If Worksheets(i).Name = nen & "." & getsu & eda And ActiveSheet.Index <> i Then Exit For
Next i
j = j + 1
Loop Until i > Worksheets.Count

ActiveSheet.Name = nen & "." & getsu & eda
End Sub

回答No.2

rivoisu

nen、getsu、は定義済みかつ値が入っているものとしています。

Sub mmmm()
Dim s As String
Dim q As Long
Dim MaxNO As Long
Dim ws As Worksheet
Dim umu As Boolean
s = nen & "." & Right("00" & getsu, 2)　'名前を作る
For Each ws In Worksheets 'すべてのWorksheetをひとつづつ処理
　　If Left(ws.Name, Len(s)) = s Then　'名前が一致（年月のみ一致も含む
　　　　umu = True1　'一致したよ！
　　　　If ws.Name = s Then
　　　　　　　　q = 0　　'完全一致のときqは0
　　　　　　Else
　　　　　　　　'そうじゃないとき括弧内の数字を取り出してｑにいれる
　　　　　　　　q = Val(Replace(Left(ws.Name, Len(ws.Name) - 1), s & "(", ""))
　　　　End If
　　　　'以下3行でｑの最大値をMaxNOに入れる
　　　　If q > MaxNO Then
　　　　　　　　MaxNO = q
　　　　End If
　　End If
Next
If umu = False Then
　　　　ActiveSheet.Name = s　'年月も一致しないとき
　　Else
　　　　ActiveSheet.Name = s & "(" & MaxNO + 1 & ")"　'一致したものがあるときMaxno+1を（）付きで付加
End If
End Sub
2009年1月は2009.1ではなく2009.01になるようにしています。
テストはしていませんので不具合があったら補足してください。今酔ってます(^^;)

回答No.1

Trick--o--

A.「2009.12」というシートが存在するか？
　No→そのままシート名を変更
B.i=2
C.「2009.12(i)」というシートが存在するか？（iは変数）
　No→シート名を変更。ループを抜ける
D.i=i+1　Cに戻る
E.おめでとう。