エクセルのシート名変更で重複した時のvbaの処理

こんにちは。vba初心者です。

セルのA１を参照してシート名を変更するとき
名前が重複したら、A1に入力されている文字列の後に（2）とつけたいのですが、
その重複したときの処理ができません。

シート名を変更するところまではできました。
以下のvbaです。

Sub test()
Dim aSheet As Worksheet
For Each aSheet In Worksheets
aSheet．Select
aSheet．Name = Range("A1")
On Error Resume Next
Next aSheet
End Sub

これに付け加えるか全然違ってもかまいません。
何かよい方法を教えてください。
説明が不十分かもしれませんが、よろしくお願いします。

No.3 ベストアンサー 回答者： jcctaira 回答日時： 2011/07/26 17:26

capybaruさん

シート名が重複したら、(2),(3)…と番号を増やすようにしました。
また、capybaruさんのプログラムをベースにしています。
　　
Sub test()
　Dim aSheet As Worksheet
　Dim NO　　 As Integer
　For Each aSheet In Worksheets
　　aSheet.Select
　　NO = 1
　　On Error Resume Next
　　Do
　　　Err.Clear
　　　aSheet.Name = Range("A1") & IIf(NO = 1, "", Format(NO, "(#)"))
　　　If Err.Number = 0 Then Exit Do
　　　NO = NO + 1
　　Loop
　　On Error GoTo 0
　Next aSheet
End Sub

この回答へのお礼

本当にありがとうございます。
助かりました。
(2),(3)・・・と増やせるようになっているのもうれしいです。

お礼日時：2011/07/27 13:31

No.5 回答者： MARU4812 回答日時： 2011/07/26 19:34

>'**本当ならここでA1の値がシート名として適切かのチェックを入れる

こういうことが原因のエラーもあるから、あまりエラーを握りつぶしすぎると
延々とカウントアップする無限ループになったりして怖いけどね。

まぁ、質問者の自己責任だけど。

この回答へのお礼

ありがとうございます。

お礼日時：2011/07/27 13:23

No.4 回答者： mt2008 回答日時： 2011/07/26 18:08

作って見ました。

ブックに含まれているシートが全部Worksheetである事が前提（グラフシート等は無い事）です。
全部のシート名を一時的に適当な名前に変えた上で目的の名前に変更しています。
コレにより、変更前のブックに付けたい名前のシートが存在している場合の問題を回避しています。

Sub sample()
　　Dim sName() As String
　　Dim aSheet As Worksheet
　　Dim i, j, k, nCount As Long
　　　　
　　ReDim sName(ThisWorkbook.Sheets.Count)
　　For Each aSheet In Worksheets
　　　　i = i + 1
　　　　sName(i) = aSheet.Range("A1") '各シートのA1を配列に
　　　　aSheet.Name = Format(Now(), "hhmmss") & CStr(i) 'シート名を一時的に適当な名前に変更
　　Next aSheet
　　
　　'**本当ならここでA1の値がシート名として適切かのチェックを入れる
　　
　　For j = 1 To ThisWorkbook.Sheets.Count
　　　　nCount = 0
　　　　For k = 1 To j
　　　　　　If sName(j) = sName(k) Then
　　　　　　　　nCount = nCount + 1
　　　　　　End If
　　　　Next k
　　　　'同じシート名が複数出来る時は（ｎ）を後ろに付ける
　　　　If nCount > 1 Then
　　　　　　sName(j) = sName(j) & "(" & CStr(nCount) & ")"
　　　　End If
　　　　Sheets(j).Name = sName(j)
　　Next j
End Sub

この回答へのお礼

どうも、ありがとうございます。

お礼日時：2011/07/27 13:25

No.2 回答者： KURUMITO 回答日時： 2011/07/26 17:10

次のようにしてはどうでしょう。

Sub test()
Dim aSheet As Worksheet
For Each aSheet In Worksheets
aSheet.Select
On Error GoTo エラー処理
aSheet.Name = Range("A1")
Next aSheet
エラー処理:
aSheet.Name = Range("A1") & "(2)"
Resume Next
End Sub

この回答へのお礼

どうも、ありがとうございます。

お礼日時：2011/07/27 13:32

No.1 回答者： MARU4812 回答日時： 2011/07/26 17:00

> セルのA１を参照してシート名を変更するとき

> 名前が重複したら、A1に入力されている文字列の後に（2）とつけたいのですが、
説明がよく分からないんだけど、A1しか参照しないなら必ず重複するのでは？
「重複したら」ってするかしないかの判断なんて要らないんじゃないの？
無条件に、数字の変数でカウントした連番つければいいだけでは？

まぁ、すでにA1に入っている文字列を使ったシートが存在したら
そういうチェックも必要だけど、シートに使われていない文字列で1回
書き換えてからA1を書き換えて、本来変えたかったシート名に変える
とか運用で逃げればいいと思っちゃう。
でないと色々と考慮しないといけないパターンが増えるからね。

変更したいシート名
Test1, Test1（2）, Test1（3）, Test1（4）
変更前のシート名
Sheet1, Sheet2, Test1, Test1（4）
だった場合、
Sheet1 → Test1
Test1 → Test1（3）
Test1（4） → Test1（4）
とかなったりしてね。どうするつもりなのです？