エクセルでのマクロでのループ処理について

質問

お世話になります。
エクセルのシートにAAA、BBB、0001,0002,0003…というシートがあり
ます。
0001、0002…は連番で最大で0050までありますがシート数は変化します。
この連番のシートの名前をそれぞれのシートのH8セルに記入されている
テキストと同じ文字にしたいのですが。
シートの名前の変更マクロは検索して見つけたのですがループさせる
方法がわかりません。
Sheets("0001").Select
For i = 1 To 100
sName = Format(i, "0000")
ActiveSheet.Name = Worksheets("sName").Range
Dim シート名 As String
シート名 = Range("h5").Value
If シート名 = "" Then
Exit Sub
End If
ActiveSheet.Name = シート名
Next

「0001シートから初めて次に0002シート0003シートと変更し
シートが見つからない時は変更を終わる。」
というように書ければいいのかなと思います。
上記の様だと0002シートへ移りません。

あまり詳しくないのでWEB検索したコードを書き足してみました。
修正箇所をご指摘頂ければ助かります。
宜しくお願いします。

回答No.10

cj_mover · ベストアンサー

こんばんは。

> sNewShNm = Trim(oSh.Range("H8").Text)のところですが
> Ｈ８とＨ９の結合での表示というのは難しいでしょうか
> 関数でいうと=Ｈ８＆Ｈ９のような感じです。
んーと、
ＶＢＡでの文字列の結合方法をお訊ねでしょうか？
普通に & 演算子で結合すればいいです。
sNewShNm = Trim(oSh.Range("H8").Text) & Trim(oSh.Range("H9").Text)
たとえば、間に "_" を挟むなら
sNewShNm = Trim(oSh.Range("H8").Text) & "_" & Trim(oSh.Range("H9").Text)
とか。（& 演算子の前後に半角空白が必要です。）

質問文で確認できなかったので保険をかけて .Text プロパティーを用いていますが、
セルＨ８，Ｈ９の値（表示ではなく値）が文字列ならば、
（或いは、値と表示が同じであることが確実か、そもそも値でよかったならば）
sNewShNm = Trim(oSh.Range("H8").Value) & Trim(oSh.Range("H9").Value)
,Value プロパティーを用いるのが通常です。
ご質問では現状のシート名が"0000"数字文字列でしたので、
セルＨ８の　値が数値、表示が桁揃えの"テキスト"である（かも知れない）場合
にも対応するように.Textを用いています。
それから、Ｔｒｉｍ()関数は"テキスト"の左右にある（かも知れない）空白を取り除くものです。
（必ずしも必要ではありません）
sNewShNm = oSh.Range("H8").Text & oSh.Range("H9").Text
または、
sNewShNm = oSh.Range("H8").Value & oSh.Range("H9").Value
のような書き方で問題なければ書き換えてもよいです。
できればセルＨ８，Ｈ９も具体例が欲しかったですね。
ところで、シート名に指定できる文字列の長さの上限は大丈夫でしょうか？
その点を含めて、ここではすべてのエラーを回避するようには書けませんので、
ご注意ください。

自己レス、
>> なるべく入門書にあるような基本的な記述を心がけて書きました。
重複処理用の関数 Function UniqName() の記述は例外です。
これは、必要かどうか判らなかったので簡易的にまとめています。

それから、
>>シート総当りでループして、シート名が"0000"書式のを判別
>>した方が、紛れがなく簡単ではないでしょうか。
この点は、私よりも前の回答でも触れられていますが、
ご提示のコードを尊重して書かれた回答として、
　　シート名を追いかけるから、
　　指定した名前のシートがない（かも知れない）場合
　　を想定してエラー処理を加えているもの
だということを、ぜひ確認しておいてください。
テキスト（教本の意）として先々、大いに参考になるものだと思います。
学習段階としては、For ～ Next を覚えてから、For Each ～ Next に
進むのが順当でしょうから、私以外の方のものが
本来妥当な回答だったかも知れません。
（私は、エラー処理のほうがハードルが高く感じてしまうんじゃないかな？
と思ってここにお邪魔しましたが、いずれ必要なことには違いありませんので）

それでは、また。

お礼

ご回答ありがとうございます。
Ｈ8とＨ9はテキストでした。問題なく出来ました。
助かります。
皆様のご意見の中でエラー回避が重要であることは理解できました。
まだまだハードルが高そうですが地道に勉強してみます。
知識不足なのですがＶＢＡ辞典やＷＥＢ検索で補足しながら作っていますが、たぶん全体の構成が出来ないうちに作りだし、修正や追加などで気がつくと無駄な動きの多いものが出来てしまいます。
もっと全体像を把握してその為のエラー回避や宣言などを考えなくてはいけませんね。勉強します。
cj_mover様にはご丁寧なご指導を頂き感謝しております。
ありがとうございました。

ご回答頂きました皆様にもこの場をお借りして深く感謝いたします。
ご丁寧なご指導ありがとうございました。

回答No.9

junichihirobe

ボタンに登録した例です。
同じフォルダにある他のエクセルファイルのシート名変更マクロです。

Private Sub CommandButton1_Click()

Dim path$, wb As Workbook, wbName$
Dim ws As Worksheet, i&
Dim nCount As Long
Dim sVal As String
Dim n As Name

path = ThisWorkbook.path & "\"

wbName = Dir(path & "*.xls")
Do Until wbName = ""
If wbName <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(path & wbName)
i = 2
Set ws = wb.Worksheets(wb.Sheets.Count)

On Error Resume Next
ws.Name = ws.Range("H8")
nCount = 1

Next
wb.Save
wb.Close
End If
wbName = Dir
Loop
Set wb = Nothing
Set ws = Nothing

End Sub

試してみてください。

お礼

ご回答頂きありがとうございます。

参考にさせていただきます。
ありがとうございました。

回答No.8

cj_mover

こんにちは。
シート総当りでループして、シート名が"0000"書式のを判別
した方が、紛れがなく簡単ではないでしょうか。
それなら、For Each ～ Next ループが使えます。
修正より着想を変えて貰った方がよいのかも知れません。

セル H8 のテキストが他シートと重複する場合
（エラー処理というよりエラー回避）
を考えなくてよいのでしょうか？

"0000-0050"と、新たなシート名（セル H8 テキスト）との
対応表（マスタ）は作ってないのでしょうか？
作らなくてよいのでしょうか？
ファイル全体の構成（設計）も気になるところです。

以下
なるべく入門書にあるような基本的な記述を心がけて書きました。

' ' ＝＝＝ ここから ＝＝＝
Sub Test_C()
Dim oSh As Worksheet
Dim sOldShNm As String, sNewShNm As String
For Each oSh In Worksheets
　　sOldShNm = Trim(oSh.Name)
　　If sOldShNm Like "####" Then
　　　　sNewShNm = Trim(oSh.Range("H8").Text)
　　　　If sNewShNm <> "" Then
' ' 重複処理が必要なら次行の記述中の ' を一文字消去。
　　　　　 ' sNewShNm = UniqName(sNewShNm)
　　　　　　oSh.Name = sNewShNm
　　　　End If
　　End If
Next oSh
End Sub
' ' ＝＝＝ ここまで ＝＝＝

' ' ▼ 重複処理 ここから ▼
Function UniqName(ByVal s As String) As String
Dim i As Integer
i = 1
Do While Evaluate("ISREF('" & s & "'!A1)")
　　i = i + 1
　　If i = 2 Then
　　　　s = s & " (" & i & ")"
　　Else
s = Replace(s, Mid(s, InStrRev(s, " (")), " (" & i & ")")
　　End If
Loop
UniqName = s
End Function
' ' ▲ 重複処理 ここまで ▲

お礼

ご回答ありがとうございます。
ご連絡が遅くなり大変申し訳ございません。

>シート総当りでループして、シート名が"0000"書式のを判別
>した方が、紛れがなく簡単ではないでしょうか。
はい。発想が固まりすぎてました。
シート名の書式判別など思いつきませんでした。
勉強になりました。

重複処理までご指導頂きありがとうございます。
問題なく実行できました。
まだまだ勉強不足を痛感しております。

sNewShNm = Trim(oSh.Range("H8").Text)のところですが
Ｈ８とＨ９の結合での表示というのは難しいでしょうか
関数でいうと=Ｈ８＆Ｈ９のような感じです。
もし、お時間が御座いましたら教えてください。

ありがとうございました。

回答No.7

Wendy02

こんばんは。

なんとなくヘンですね。

　　sName = Format(i, "0000")
　　ActiveSheet.Name = Worksheets(sName).Range("H8").Value

>シートが見つからない時は変更を終わる。
というよりも、シート名の変更を、それぞれのシートのH8に依存しているのでしたら、シート名を探す必要があるのでしょうか？単に、"0000"というフォーマットになっているところだけを探して、そのシートの中のH8にある文字を探せばよいのではないでしょうか。

「連番で並んでいる」という条件なら、最初に、0001を探し、それが、シートタブの左端に近いほうにあると考えました。ただし、右側の方にあるとなると、コードが変わってきてしまいます。

とりあえず、こんな風に考えてみました。ループ内でエラーが発生したら、次に飛ぶようにしました。その時に、エラーの発生したシートを記録するようにしました。

なお、元のコードはあまり参考にはしていません。エラーの発生する可能性をいくつか対処しなくてはなりません。
'-------------------------------------------

Sub ShNameChangeTest1()
　　Dim sName As String
　　Dim i As Long
　　Dim nCount As Long
　　Dim Data As Variant
　　On Error Resume Next
　　nCount = Sheets("0001").Index　'最初のシートの始まり
　　If Err.Number > 0 Then MsgBox "0001シートがありません", vbExclamation: Exit Sub
　　On Error GoTo 0
　　On Error GoTo ErrHandler
　　For i = nCount To Worksheets.Count
Jump:
　　　　If Worksheets(i).Name Like "####" Then
　　　　　　sName = Worksheets(i).Range("H8").Value
　　　　　　If sName <> "" Then
　　　　　　　　Worksheets(i).Name = sName
　　　　　　End If
　　　　End If
　　Next i
　　If Len(Data) > 2 Then
　　　 MsgBox "Sheet" & Mid(Data, 2) & "にエラーが発生しています。", vbExclamation
　　End If
　　Exit Sub
ErrHandler:
　　Data = Data & ", " & Worksheets(i).Name
　　i = i + 1
　　GoTo Jump
End Sub

お礼

ご回答ありがとうございます。
私のサンプルブックに設定間違いがあり実行に時間がかかってしました。
修正すると問題なく動きました。
ありがとうございます。
今後、頂いたコードの理解を深めるように勉強させていただきます。
機会がございましたらまたご指導ください。
ありがとうございました。

回答No.6

mshr1962

問題は4行目の
ActiveSheet.Name = Worksheets("sName").Range
開いているシート名をsNameシートのA1セルの内容に書き換えですね。
マクロ実行時にシートを移動しながら行うなら
Worksheets("sName").Activate
ActiveSheet.Name = Worksheets("sName").Range("H8")
ですし、シートの移動を行わなくていいなら
Worksheets("sName").Name = Worksheets("sName").Range("H8")
でOKです。

マクロサンプル
Sub sNamec()
On Error GoTo lastend 'シートが見つからない場合に対応
x = 0　'変更したシート数のカウンタ変数
For i = 1 To Worksheets.Count - 2　'0001～Book内のシート数-2までループ
sName = Format(i, "0000") 'シート名を変更するシート名
Sheets(sName).Name = Sheets(sName).Range("H8")　'シート名をH8セルの文字に変更
x = x + 1　'カウンタ+1
Next
lastend:
MsgBox "シート名変更終了しました" & Chr(13) & x & "件変更しました。" 'マクロの終了案内＋件数表示
End Sub

お礼

ご回答ありがとうございます。
頂いたサンプルで実行できました。
私のサンプルブックの設定ミスで当初うまく動きませんでしたが修正後、
問題なく実行できました。ありがとうございます。

回答No.5

noname#252806

sName = Format(i, "0000")の次に
Worksheets(sName).selectを入れないと
次のシートに移りません。

お礼

ご回答ありがとうございます。
遅くなり大変申し訳ございません。

参考にさせていただきます。
ありがとうございました。

回答No.4

kmetu

> ループ数の制限というよりループしないので困っています。

シートが見つからない時は変更を終わる。

のではなくて
シート数分だけループする方法をお知らせしました

ですので

Dim シート名 As String
シート名 = Range("h5").Value
If シート名 = "" Then
Exit Sub
End If

がいりませんから、ループしなくなるということはありませんし
条件分岐　IF文がないだけ無駄な処理がなくなりますから
エラーが出る可能性も減ります。

お礼

ご回答頂きありがとうございます。
遅くなり大変申し訳ございません。
>シート数分だけループする方法をお知らせしました

すみません。頭が固くて理解できませんでした。
発想を少し変えるとご指摘の通りの方法がやっと理解できました。
もっと柔軟性が必要ですね、反省します。
ありがとうございました。

回答No.3

myRange

>AAA、BBB、0001,0002,0003…というシートがあり

これからすると、対象となる数字のシートは何枚あったとしても
必ず全体のシート数より２枚少ないことになるので１～１００まで回す必要はないですね。
'-----------------------------
Sub Test()
　　Dim i As Integer
　　Dim sName As String

　　For i = 1 To Worksheets.Count - 2
　　　　sName = Format(i, "0000")
　　　　Worksheets(sName).Name = Worksheets(sName).Range("H8").Value
　　Next i
End Sub
'-----------------------------

うんにゃ、どうしても１～１００まで回すんだ、
ということであれば次のようにエラー処理を利用するといいでしょう。
'-----------------------------
Sub Test2()
　　Dim i As Integer
　　Dim sName As String

　　On Error Resume Next

　　For i = 1 To 100
　　　　sName = Format(i, "0000")
　　　　Worksheets(sName).Name = Worksheets(sName).Range("H8").Value
　　　　If Err.Number > 0 Then Exit For
　　Next i

　　On Error GoTo 0
End Sub
'-----------------------------

●シート名の入っているセルは、Ｈ８ですよね？
質問では、Ｈ８なんですが、質問者のコードでは、ｈ５になってます。
以上です。

お礼

ご回答ありがとうございます。
お礼が遅くなり大変申し訳ございません。

>必ず全体のシート数より２枚少ないことになるので１～１００まで回す必要はないですね。

なるほど！そのような発想はありませんでした。勉強不足ですね。
多めに設定しておけば増えた場合も直さなくてもいいかなという程度の考えでした。
勉強になりました。
*コードはＨ５でした。すみませんでした。
ありがとうございます。

回答No.2

kmetu

Worksheets.Count

でシート数が取得できますので

For i = 1 To Worksheets.Count

にしておくとシート数分ループします。

お礼

早々のご回答ありがとうございます。
ループ数の制限というよりループしないので困っています。
どこが原因なのでしようか。

回答No.1

nza49739

ループ数を制限したいということでよろしいでしょうか？

ひとつのBookにいくつのシートがあるかを知るのは簡単です。
シートの数だけ、ループしたいということですので、

For i = 1 To WorkSheets.Count

とすればOKです。

お礼

早々のご回答ありがとうございます。
ループ数の制限というよりループしないので困っています。
どこが原因なのでしようか。