エクセルのワークシートの並べ替え

質問

エクセル２０００を使っていますが、シートがsheet1～sheet**まで並んでいます。（そのファイルによって数は違いますが、シート名は必ずしも1～ではなく、また、必ずしも1つづつ増える数でもありません。どのファイルもシートは100以上あります)
これを逆順に並べ替えたいのですが、どのようにすれば良いのでしょうか？多分、マクロを組めば良いのでしょうが。。。。。
　ちなみに、全てのシートにデータが入っています。

回答No.4

ja7awu · ベストアンサー

>　必ずしも、今回の例のように、４桁プラスαということでもないのですが・・・

前にも書きましたが、もし3桁があると200 は、1000 より後に（昇順時で）
なりますよ。　文字列ですから・・・

シート名を付ける基準を書いていただければ、それなりにコーディング
できるのですが、解らない部分は、推測するないですからね。
まぁ、使って見てください。　ごくろうさま。

お礼

ありがとうございます。今のところ、これで十分です。また、わからなくなったら、新たに質問したいと思いますので、そのとき見つけたらよろしくお願いします。

回答No.3

ja7awu

> 私の何が悪いのでしょうか？

「実行時エラー」は、全て作る側の責任です。ここは単純ミスです。

> 私には、規則がわからない順に並んでいます。

そうね。これはちょっと解んないと思いますよぉ～。
1234は、"イチニサンシ(ヨン?)" でソートになったかも知れませんよ。
漢字のシート名を「振り仮名」でソートしたい場合に対応させようとした
のが数字まで仮名になったようです。

汎用性を持たせて、余分な機能を付加したのが、仇になったようです。
何となく気になっていたのですが、やはり検証不足でした。ごめん。

質問で「シートがsheet1～sheet**まで並んでいます。」とありましたので
sheet に続く番号が、1桁～3桁あるとすれば、そのまま文字列で処理すると
例え昇順でソートすると Sheet12 が Sheet3 より 前に来てしまいます。

ですから、質問を見て番号を「数値」に変換する必要性を感じた訳です。
どうもそうではなくて４桁プラスα のようなので「文字列」で処理しました。

今回、シート名の例を書いて頂いたので、それに合うよう変更しました。
下記コードに入れ替えてください。

たぶん、これでいいかと思います。　

Sub SortSheets()
Dim Wwh As Worksheet
Dim N As Integer
Const UpDown = 1 ' <---- １=昇順　/　２=降順 を指定
Application.ScreenUpdating = False
Sheets.Add Before:=Worksheets(1)
Set Wwh = ActiveSheet
With Wwh
　　.Visible = False
　　For N = 2 To Worksheets.Count
　　　　.Cells(N - 1, 1).Value = Worksheets(N).Name
　　　　.Cells(N - 1, 2).Value = "'" & .Cells(N - 1, 1).Text
　　Next N
　　If UpDown <> 2 Then
　　　　.Range("A1").CurrentRegion.Sort Key1:=.Range("B1"), _
　　　　Order1:=xlAscending, Header:=xlNo, OrderCustom:=1
　　Else
　　　　.Range("A1").CurrentRegion.Sort Key1:=.Range("B1"), _
　　　　Order1:=xlDescending, Header:=xlNo, OrderCustom:=1
　　End If
　　For N = 1 To .Range("A1").End(xlDown).Row
　　　　Worksheets(.Cells(N, 1).Text).Move After:=Sheets(N)
　　Next N
End With
For N = 2 To Worksheets.Count
　　If Worksheets(N).Visible = xlSheetVisible Then
　　　　Worksheets(N).Activate
　　　　Exit For
　　End If
Next N
Application.DisplayAlerts = False
Wwh.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set Wwh = Nothing
End Sub

お礼

色々とありがとうございます。
>ですから、質問を見て番号を「数値」に変換する必要性を感じた訳です。
>どうもそうではなくて４桁プラスα のようなので「文字列」で処理しました。　
　必ずしも、今回の例のように、４桁プラスαということでもないのですが、４桁プラスαのものが一番多いですし、今回のＶＢＡで試してみたいと思います。
　今、いくつかのファイルを試したら、全てＯＫでした。ありがとうございました。
　色々な方のＶＢＡを参考にしながら、自分でもと思いますが、なかなか難しくて。本当にありがとうございました。

回答No.2

ja7awu

次のマクロを実行すると、ご希望通り、シートが並べ替えられると思います。

シート名を、その名称の共通部分に付加される数値でシートを並べ替えます。
共通部分を指定しないときは、シート名を「漢字振り仮名順」で並べ替えます。
ただし、この場合は、MS-IMEを使用しているものとします。

共通部分を指定した場合、その前後ともに数字がある場合は、双方の数字を
連結した値を基準に整列します。(つまり、前に付いても、後ろについてもＯＫです。)

Excel2000か、それ以降に対応します。

一応、ご存知かも知れませんが、ＶＢＡの設定方法を書いておきます。

１．Alt + F11 で VBE(Visual Basic Editor)を開きます。
２．VBE のメニューから[挿入] -->[標準モジュール] を指定します。
３．モジュールウィンドウに下記コードをコピーして貼り付けます。
４．４～５行目を実情に合わせ設定します。
５．Alt + Q （または、右上隅の×）でウィンドウを閉じ、シートに戻ります。
６．メニューから[ツール]-->[マクロ]-->[セキュリティ]で「セキュリティレベル」を
　「中」にして[OK]します。
７．実行するときは、Alt ＋ F8 (メニューから[ツール]-->[マクロ]-->
　　[マクロ])で「SortSheets」を指定し、[実行]ボタンを押します。

これでソート出来たと思いますが、如何でしょうか。

Sub SortSheets()
Dim Wwh As Worksheet
Dim N As Integer
Const UpDown = 2 ' 　　　　<---- １=昇順　/　２=降順 を指定
Const Kyutso = "Sheet" ' 　<----- 共通名称(小/大文字を識別) 無しは""のみ
Application.ScreenUpdating = False
Sheets.Add Before:=Worksheets(1)
Set Wwh = ActiveSheet
With Wwh
　　.Visible = False
　　For N = 2 To Worksheets.Count
　　　　.Cells(N - 1, 1).Value = Worksheets(N).Name
　　　　If Kyutso <> "" Then
　　　　　　.Cells(N - 1, 2).Value = _
　　　　　　Replace(.Cells(N - 1, 1).Value, Kyutso, "")
　　　　End If
　　　　.Cells(N - 1, 2).Value = _
　　　　Application.GetPhonetic(.Cells(N - 1, 2).Value)
　　Next N
　　If UpDown <> 2 Then
　　　　.Range("A1").CurrentRegion.Sort Key1:=.Range("B1"), _
　　　　Order1:=xlAscending, Header:=xlNo, OrderCustom:=1
　　Else
　　　　.Range("A1").CurrentRegion.Sort Key1:=.Range("B1"), _
　　　　Order1:=xlDescending, Header:=xlNo, OrderCustom:=1
　　End If
　　For N = 1 To .Range("A1").End(xlDown).Row
　　　　Worksheets(.Cells(N, 1).Text).Move After:=Sheets(N)
　　Next N
End With
For N = 2 To Worksheets.Count
　　If Worksheets(N).Visible = xlSheetVisible Then
　　　　Worksheets(N).Activate
　　　　Exit For
　　End If
Next N
Application.DisplayAlerts = False
Wwh.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set Wwh = Nothing
End Sub

補足

ありがとうございます。
"Sheet"を""として、実行してみたのですが、
実行時エラー　'1004':
並べ替えの参照が正しくありません。並べ替えるデータ内にあることと、[最優先されるキー]ボックスが空白でないことを確認してください。
　と表示されます。
　デバックを押すと
.Range("A1").CurrentRegion.Sort Key1:=.Range("B1"), _
Order1:=xlDescending, Header:=xlNo, OrderCustom:=1
　この部分が黄色くなっています。
　そこで、
>Const Kyutso = "Sheet" ' 　<----- 共通名称(小/大文字を識別) 無しは""のみ
　この"Sheet"を" "としたところ、実行はされるのですが、昇順でも降順でもなく、私には、規則がわからない順に並んでいます。
　ちなみに、今回試したファイルは、1122,1129,1128,1126,1125,1123,1120,1172R1,1172,1171R1のように並んでいます。
このファイルは、1000～1200＋所々に1172R1,1172R3などが入っています。
　私の何が悪いのでしょうか？

回答No.1

imogasi

５つぐらいでテストではＯＫですが、あまり自信はありません。本番のブックのコピーを取って、慎重にテストして見てください。
（１）ブック内のシート名をＳｈｅｅｔ１のＡ列に出します。
Sub test02()
' MsgBox Sheets.Count
For i = 1 To Sheets.Count
Worksheets("sheet1").Cells(i, 1) = Sheets(i).Name
Next i
End Sub
余分なシートを１つ挿入して、その名前をWorksheets("sheet1").のSheet1と置換えてください。
そして実行（Ｆ５）する。
（２）手動ソート
Ｓｈｅｅｔ１のＡ列範囲指定して、データ－並べ替え－Ａ列－降順で並べ替えます。
ここ（２）はあえて、ＶＢＡにしていません。（ＶＢＡにも簡単に出来ますが。）
（３）シートのタブ位置の並べ替え
下記を実行する。
Sub test03()
For i = 1 To Sheets.Count - 1
s1 = Worksheets("sheet1").Cells(i, "A")
s2 = Worksheets("sheet1").Cells(i + 1,"A")
Application.Worksheets(s2).Move , ActiveWorkbook.Worksheets(s1)
Next i
End Sub
（Moveのあと１スペースのあとカンマをもらさないように。）