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

Question

お世話になります。
エクセルのシートに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検索したコードを書き足してみました。
修正箇所をご指摘頂ければ助かります。
宜しくお願いします。

cj_mover · Accepted Answer

こんばんは。

> 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 に
進むのが順当でしょうから、私以外の方のものが
本来妥当な回答だったかも知れません。
（私は、エラー処理のほうがハードルが高く感じてしまうんじゃないかな？
と思ってここにお邪魔しましたが、いずれ必要なことには違いありませんので）

それでは、また。

junichihirobe · Answer

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

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

試してみてください。

cj_mover · Answer

こんにちは。
シート総当りでループして、シート名が"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
' ' ▲ 重複処理 ここまで ▲

Wendy02 · Answer

こんばんは。

なんとなくヘンですね。

　　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

mshr1962 · Answer

問題は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

rex9200 · Answer

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

kmetu · Answer

> ループ数の制限というよりループしないので困っています。

シートが見つからない時は変更を終わる。

のではなくて
シート数分だけループする方法をお知らせしました

ですので

Dim シート名 As String 
シート名 = Range("h5").Value
If シート名 = "" Then 
Exit Sub
End If

がいりませんから、ループしなくなるということはありませんし
条件分岐　IF文がないだけ無駄な処理がなくなりますから
エラーが出る可能性も減ります。

myRange · Answer

>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
'-----------------------------

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

kmetu · Answer

Worksheets.Count

でシート数が取得できますので

For i = 1 To Worksheets.Count

にしておくとシート数分ループします。

nza49739 · Answer

ループ数を制限したいということでよろしいでしょうか？

ひとつのBookにいくつのシートがあるかを知るのは簡単です。
シートの数だけ、ループしたいということですので、

For i = 1 To WorkSheets.Count

とすればOKです。

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

こんばんは。

ボタンに登録した例です。

こんにちは。

こんばんは。

問題は4行目の

sName = Format(i, "0000")の次に

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

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

Worksheets.Count

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

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング