シート見出し名の下2桁を ”必ず ” 連番 かつ 12の倍数にするには？

基本は、シート見出し名の　下2桁だけが、　連番　　かつ　　12の倍数で、　昇順になっていますが、　”たまに”　一部シートが抜けている （ ない ） 時がありますので、

マクロ実行後に、

きちんと　合計　　12枚 　or　 24枚 　or　 36枚　　にしたいのです。
抜けている （ ない ） 場合、　抜けているシート数は、多くても　　4・5枚　です （ 抜けているシートの場所は変動します ）。

3通り　のマクロが必要のように思いますが、下記例の　1通り　をどうかご教授下さいませ。
-----------------------------
'下記例は、
　　抜けているシート　4番目　と　最終の36番目　を挿入し、シート数を　合計36　にしたい場合の例です。
'この場合、マクロ実行前は　シート数36　を超えることはありません。
'「　**01 ～ **12　」　は、必ず昇順になっています。

ブック1（ 実行前シート数　合計34 ）
シート見出し
**01　**02　**03　　　　**05　**06　・・　**12　**01　・・　**12　**01　・・　**11

↓↓↓↓
ブック1（ 実行後シート数　合計36 ）
シート見出し
**01　**02　**03　　挿入したシート1　　**05　　**06　・・　**12　**01　・・　**12　**01　・・　**11　　挿入したシート2

No.3 ベストアンサー 回答者： zap35 回答日時： 2006/12/28 13:34

＃０２です。

前提について補足しなければなりませんでした。
このマクロは１２枚ずつのシート名のプリフィックス（**の部分）は同じものであるという前提で書きました。
つまり最終的にAAAA01～AAAA12、BBBB01～BBBB12、CCCC01～CCCC12のようなシート構成を想定しています。

もしプリフィックスがバラバラならば補足してください。
なおその場合挿入するシートのプリフィックスはどうすればよいのかも書いてください。（数字２桁だけでは同じ名前になる可能性があるので不適です）

No.2 回答者： zap35 回答日時： 2006/12/28 12:55

並び順でシートの抜けを見つけなければならないので無駄な処理もありますがこんなマクロでできると思います。

一応のテストはしました。

マクロはALT＋F11でVBE画面を開き、「VBAProjectエクスプローラのシート名右クリック」→「挿入」→「標準モジュール」で表示される画面にペーストして下さい。実行はシート画面に戻って、ALT＋F8を押してマクロ一覧からマクロ名を選択します。

Sub ShtInsert()
Dim shIdx, idx As Integer
Dim Prefix, svPrefix As String
　On Error Resume Next
　For shIdx = 1 To Worksheets.Count
　　ActiveSheet.Previous.Select
　Next shIdx
　For idx = 1 To 3
　　Prefix = Left(ActiveSheet.Name, Len(ActiveSheet.Name) - 2)
　　If Prefix <> svPrefix Then
　　　svPrefix = Prefix
　　　shIdx = 1
　　　Do While shIdx < 13
　　　　If Not IsNumeric(Right(ActiveSheet.Name, 2)) Then
　　　　　MsgBox ("シート名下二桁が数字でないため中止しました")
　　　　　Exit Sub
　　　　End If

　　　　If Val(Right(ActiveSheet.Name, 2)) = shIdx _
　　　　　　And Left(ActiveSheet.Name, Len(ActiveSheet.Name) - 2) = Prefix Then
　　　　Else
　　　　　If Left(ActiveSheet.Name, Len(ActiveSheet.Name) - 2) = Prefix Then
　　　　　　If shIdx > Val(Right(ActiveSheet.Name, 2)) Then
　　　　　　　Worksheets.Add after:=ActiveSheet
　　　　　　　ActiveSheet.Name = Prefix & Application.Text(shIdx, "00")
　　　　　　Else
　　　　　　　Worksheets.Add.Name = Prefix & Application.Text(shIdx, "00")
　　　　　　End If
　　　　　Else
　　　　　　Worksheets.Add.Name = Prefix & Application.Text(shIdx, "00")
　　　　　End If
　　　　End If
　　　　ActiveSheet.Next.Select
　　　　shIdx = shIdx + 1
　　　Loop
　　End If
　Next
End Sub

プログラムはコード整理していないので見にくくてすみません。でも下手にWithで整理すると動かなくなるので注意してください

この回答へのお礼

誠に有難うございました。
＞のようなシート構成を想定しています。
zap35様の想定の通りでございます。
プリフィックスまでは、自身の希望以上でした。

お礼日時：2006/12/28 23:25

No.1 回答者： nicotinism 回答日時： 2006/12/28 09:24

標準モジュールでこんな風かな？エレガントじゃないけど

１２・２４・３６全てに有効です。詳しいテストはしてません (^_^)v

Sub test()
Dim shCount As Integer
Dim TempShName As String
Dim i As Integer

shCount = Worksheets.Count

'１２で割って余りが ０ なら何もしない。Mod 演算子は余りを、\ 演算子は商を求めます
If shCount Mod 12 = 0 Then
　　Exit Sub
End If

For i = 1 To ((shCount \ 12) + 1) * 12
　　TempShName = _
　　　　　　CStr(i \ 12 - (i Mod 12 <> 0)) & "-" & _
　　　　　　Format(IIf(i Mod 12 = 0, 12, i Mod 12), "00")
　　
　　'（１）シート数がカウンタ（i） より少ない
　　If Worksheets.Count < i Then
　　　　Worksheets.Add after:=Worksheets(Worksheets.Count)
　　　　ActiveSheet.Name = TempShName
　　'（２）シートの添え字がカウンタから得られた添え字より大きい
　　ElseIf Val(Right(Sheets(i).Name, 2)) > IIf(i Mod 12 = 0, 12, i Mod 12) Then
　　　　Worksheets.Add before:=Worksheets(i)
　　　　ActiveSheet.Name = TempShName
　　'（３）
　　ElseIf Val(Right(Sheets(i).Name, 2)) < IIf(i Mod 12 = 0, 12, i Mod 12) Then
　　　　Worksheets.Add after:=Worksheets(i - 1)
　　　　ActiveSheet.Name = TempShName

　　End If

Next
End Sub

この回答へのお礼

希望以上のご回答でした。
どちら様も、超良回答でした。
TempShName　までも誠に有難うございました。

お礼日時：2006/12/28 23:23