エクセル 漢字のシート名をあいうえお順に並び替え

質問

エクセル2003を使っています。
シートが80ほどあり、シート名は漢字で氏名になっています。
その80あるシートをあいうえお順に並べたいと思っています。

別のサイトで下記を見つけたので、使いました。

並びかわりましたが、漢字を使っているせいか、あいうえお順に
並び変わりませんでした。
試しに、２～３のシート名をカタカナに変えたら正しく並び変わりました。
やはり、漢字だとうまく並びかわらないのでしょうか。
また、何か別の方法はありますか？
教えて下さい。

Sub SortSheets()
Dim intLoopA As Integer
Dim intLoopB As Integer
For intLoopA = 1 To Sheets.Count
For intLoopB = 1 To Sheets.Count - 1
If Sheets(intLoopB).Name > Sheets(intLoopB + 1).Name Then
Sheets(intLoopB).Move after:=Sheets(intLoopB + 1)
End If
Next intLoopB
Next intLoopA
End Sub

回答No.4

marbin · ベストアンサー

アクティブブックのシート一覧を取得する方法も
書いておきます。

Sub shtget()
Dim i As Integer
Dim wba As Workbook
Dim wbb As Workbook
Dim ws As Worksheet
Set wba = ThisWorkbook
Set wbb = ActiveWorkbook
i = 0
For Each ws In wbb.Worksheets
i = i + 1
wba.Worksheets(1).Cells(i, 1).Value = ws.Name
Next ws
Set wbb = Nothing
Set wba = Nothing
End Sub

補足

す・すごい！！！びっくりです。
すごい過ぎますので、もう一つ質問させて下さい。

「シート一覧をセルに読込み、シート名の隣に振り仮名を入力・・・」
これはシート名から漢字を読み込んでいる為に、=PHONETIC(A1)では振り仮名が表示されず、隣に振り仮名を入力する必要ということでしょうか。
それならば、各シートのＥ６に入力されている氏名には、振り仮名情報の有るので、シート名からではなく、各シートのＥ６のから読み込めれば、読み込んだ漢字の隣に振り仮名を入力しなくても、=PHONETIC(A1)で並び替えできるでしょうか？
筋違いな事を言っていましたら、すいません。

80もの名前にふりがなを振る

回答No.11

marbin

>実行時エラー　1004
>アプリケーション定義またはオブジェクト定義のエラーです

セルに振り仮名情報がないときも同じエラーになるのですが、
それとは違うということですしデバッグの画面も出ない、という
のでは私にはこれ以上分かりません。

↓はデバッグの方法です。参考にしてみてください。
http://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub04_030.html

お礼

丁寧なご説明ありがとうございました。
じっくりやってみたいと思います。

長々とすいませんでした。

また何かありましたら、お願い致します。

回答No.10

marbin

実行時エラー　1004
>アプリケーション定義またはオブジェクト定義のエラーです

セルに振り仮名情報がない、ということはないですか？
デバッグ画面で
intLoopB
の上にマウスカーソルを持っていくとエラーになるシートの
シート名が分かりますので、該当シートのE6セルに振り仮名
情報があるか確認してください。

もし振り仮名情報があるのでしたら、↓をご提示下さい。

>デバッグ画面が表示されるのでしたら、
>どの行でエラーになるのかもご提示下さい。

>デバッグ画面で黄色く表示される行です。

補足

E6セルの振り仮名情報についてですが、振り仮名の表示／非表示のところで、表示にすると、漢字の上に振り仮名が表示されるので、問題ないと思います。

デバッグ画面については、デバッグ画面が表示されません。
エラーがあるとデバッグ画面が表示され、エラーの箇所が黄色く表示されることは知っていたのですが、その表示されません。

先ほど教えて頂いたシート名だけを吸い上げ、シートをあいうえお順に並び替えることは問題なくできるのですが、エルセル自体の調子がわるいのでしょうか？

回答No.9

marbin

デバッグ画面が表示されるのでしたら、
どの行でエラーになるのかもご提示下さい。

デバッグ画面で黄色く表示される行です。

補足

実行時エラー　1004
アプリケーション定義またはオブジェクト定義のエラーです

と表示されています。
誠にすいません。

回答No.8

marbin

>×　400

数字のほかにメッセージも出てないですか？

回答No.7

marbin

>「×（バツ） 400」

どこに表示されるのでしょう？
VBAのエラーメッセージでしょうか？

補足

マクロを実行した際です。
Microsoft Visual Basic
×　400

こんな感じです。

すいません。

回答No.6

marbin

先ほどのレスのとおりtovtightさんのコードを1行変えるだけですので
私のコードは無用の長物になりましたが、一応補足しておきます。

>これはシート名から漢字を読み込んでいる為に、=PHONETIC(A1)では振り仮名が表示されず、
>隣に振り仮名を入力する必要ということでしょうか。

そういうことです。
↓はシート名に加えてセルからふりがなを取得する方法です。

Sub shtget2()
Dim i As Integer
Dim wba As Workbook
Dim wbb As Workbook
Dim ws As Worksheet
Set wba = ThisWorkbook
Set wbb = ActiveWorkbook
i = 0
For Each ws In wbb.Worksheets
i = i + 1
wba.Worksheets(1).Cells(i, 1).Value = ws.Name
wba.Worksheets(1).Cells(i, 2).Value = ws.Range("E6").Phonetics(1).Text
Next ws
Set wbb = Nothing
Set wba = Nothing
End Sub

回答No.5

marbin

tovtightさんのコードを1行変えるだけでもいけますね。
検証不足でした。

If Sheets(intLoopB).Name > Sheets(intLoopB + 1).Name Then
↓
If Sheets(intLoopB).Range("E6").Phonetics(1).Text > Sheets(intLoopB + 1).Range("E6").Phonetics(1).Text Then

補足

ご回答ありがとうございました。
一行コードを変更してみましたが、エラー？なのか
実行したら
「×（バツ） 400」
と表示され、動きませんでした。

自分の知識不足でどこが間違っているかわかりませんでした。
すいません。

Sub SortSheets()
　Dim intLoopA As Integer
Dim intLoopB As Integer
For intLoopA = 1 To Sheets.Count
For intLoopB = 1 To Sheets.Count - 1
If Sheets(intLoopB).Range("E6").Phonetics(1).Text > Sheets(intLoopB + 1).Range("E6").Phonetics(1).Text Then
Sheets(intLoopB).Move after:=Sheets(intLoopB + 1)
End If
Next intLoopB
Next intLoopA
End Sub

回答No.3

marbin

>各シートの「Ｅ６」のセルにシート名と同じ氏名が入力されています。

振り仮名情報の有無如何によります。
振り仮名情報が無いなら自分で付与してやる必要があります。
=PHONETIC(A1)
として振り仮名が表示されるなら情報がありますし、
A1セルの値がそのまま表示されるのなら情報がありません。
振り仮名情報を付与するのは、
書式→ふりがな→編集
でできます。

ただ、シート並び替えのためだけならわざわざセルに振り仮名を設定し
てやる必要はありません。
シート一覧をセルに読込み、シート名の隣に振り仮名を入力、振り仮名
をキーにソート、で振り仮名順に並べ替えられます。

並べ替えられたシート名でシートを並べ替えます。
↓はA1からA列の最終行のシート名に基づいてシートを並べ替えます。
シート名はA1から入ってますが、ループのセル範囲がA2からになっている
のがミソです。
なお、これはシートを並べ替えるブックとは別のブックにマクロを記述します。
そして、シートを並べ替えるブックをアクティブにした状態でマクロを実行して
ください。

Sub shtnarabekae()
Dim wba As Workbook
Dim wbb As Workbook
Dim c As Range
Set wba = ThisWorkbook
Set wbb = ActiveWorkbook
For Each c In wba.Worksheets(1).Range(wba.Worksheets(1).Range("A2"), wba.Worksheets(1).Range("A65536").End(xlUp))
wbb.Worksheets(c.Value).Move after:=wbb.Worksheets(c.Offset(-1).Value)
Next c
Set wbb = Nothing
Set wba = Nothing
End Sub

回答No.2

marbin

#1です。
補足です。

漢字は振り仮名情報がない場合は、音読みの順に並ぶと思います。

↓の場合は、昇順の場合、原田の方が上になります。

原田　ゲンデン
今井　コンセイ

回答No.1

marbin

セルの場合は、手入力で漢字変換した場合は振り仮名情報
があるので振り仮名を使って並べ替えができますが、
シート名には振り仮名情報は無いと思います。

セルにシート名一覧を取得し手作業で隣のセルに振り仮名を
付け、セルをソート、ソート後の並び順でシートを並べ替える、
ということになると思います。

出来れば自ブックではなく、別ブックにシート一覧を取得した
ほうがいいかもしれません。

補足

「セルの場合は、手入力で漢字変換した場合は振り仮名情報
があるので振り仮名を使って並べ替えができますが・・・・」

とありますが、各シートの「Ｅ６」のセルにシート名と同じ氏名が入力されています。
そうなると、それを使って、シートを並べ変えることはできますか？