• 締切済み

エクセルのシートをマクロで並び替えたいです。

以前に、Q&Aがあったので、下記の物を入れてみましたが、シート名に会社名を入れている為、前(株)○○となると、全て(株)で集まってしまいます。 エクセル2003を使っています。 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 ご理解いただけますでしょうか？ お分かりになられる方宜しくお願い致します。

みんなの回答

  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.2

＃１です。 Debug.Print　やステップ実行しながら確認しないと、 どのような判断でどう動いているか今一つ追い切れません。 と言う感じでしょうか。

aquacube
質問者

お礼

ちょっと難しいことが良くわからないのですが、マクロ実行後の並びを確認した所、カタカナで書かれた名称はまともに並んでいる漢字でした。 従いまして、お教え頂いた(株)を外して並び替えをすることで、カタカナだけで書かれた名称が先に並び　次に(株)の後にカタカナで書かれた会社名は、ちゃんと順番に並んでおりました。 その後の漢字に問題があるようです。 とは言え、現状の状態でも元々の並び方よりは見やすくなりましたので、有難う御座いますm(_ _)m

  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.1

（株）を置換した状態で比較するとか。 If Sheets(intLoopB).Name > Sheets(intLoopB + 1).Name Then 　　　↓ If Replace(Sheets(intLoopB).Name, "（株）", "") > Replace(Sheets(intLoopB + 1).Name, "（株）", "") Then

aquacube
質問者

お礼

有難う御座いますm(_ _)m (株)の入った分は、揃わずなにやら並べ替えは動いたのですが、、、 今の現状のままだと 「(株)河○」「国際○○(株)」「大喜○○(株)」「(株)大阪○○」「大○○○(株)」「(株)菅○○」「大阪○○」「大阪○○(株)」 などのような並び方になってしまいます。 それぞれ手打ちで、変換して表示しているのですが、、、 何故でしょうか、、、

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

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

    エクセル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

  • シートが文字列で並び替えられて困っています。

    エクセル2003を使用しています。 シートの並びについて、文字列（名前順）ではなく、数値順に並び替えたいのですが、 どのようなマクロを組めば良いのでしょうか？ ↓これですと、シートの並びが文字列（名前順）になってしまうので、ダメなんです。 ------------------------------- Sub Sort() 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 ------------------------------- 例として、　01.午前中/02.午後/100/300/50/テスト　ではなく、 理想型は　01.午前中/02.午後/50/100/300/テスト　の順番です。 シート名に番号+日本語を付けているのがあるのは、数字の並び順になって欲しい対策です。 分かりやすくするために簡略化いたしましたが、 実際は300ほどのシートがバラバラに出入りし、それらは連番ではありません。 数値順にするvbaをよろしければ教えて頂けませんでしょうか。 よろしくお願いいたします。

  • シートをコピーして　シートに１から連番をふる

    （マスター）というシートがありまして、そのシートをコピーしてシート名に１からの連番をふる マクロをお教え下さい。 Sub sub_CopySample() Dim myLooP As Integer For myLooP = 1 To 10 Sheets("マスター").Copy After:=Sheets(myLooP) Next myLooP For myLooP = 1 To 10 Sheets(myLooP + 1).Name = myLooP Next myLooP End Sub これだと止まりません。 １シートづつ増やしたいのですが。

  • Excel 複数　シートコピー　同時に名前も・・・

    Excelのシートコピーを複数つくるVBAを探しています。 Sheet1を10シートコピーする場合に方法はありますでしょうか？ 本当は、それの名前もVBAで変更できればよいと考えているのですが、とりあえずシート名の変更は、以下のVBAでできました。 Sub シート名変更() Const OrgSh = "Sheet2" Dim Rw As Long Dim Cnt As Integer Sheets(OrgSh).Move Before:=Sheets(1) For Cnt = 2 To Sheets.Count Sheets(Cnt).Name = "Tentative" & Cnt Next For Cnt = 2 To Sheets.Count Sheets(Cnt).Name = Cells(Cnt, 1).Value Next End Sub なので、最初にシートをコピーして、名前を変更する、2段構えの覚悟はできています。 シートコピーのみでもよいので、だれか教えていただけませんか？

  • エクセルVBAで一番左の可視シート名を取得

    エクセルVBAで一番左側にあるシート名を取得する場合、通常は Sub test01() 　　MsgBox Sheets(1).Name End Sub で簡単にできますが、このSheets(1)が非表示になっている場合でもその名前が取得されるため、見た目での一番左側にあるシート名ではなくなってしまいます。 もちろん、非表示になっているシートを除外して Sub test02() 　　Dim n As Integer 　　For n = 1 To Sheets.Count 　　　　If Sheets(n).Visible Then 　　　　　　MsgBox Sheets(n).Name 　　　　　　Exit For 　　　　End If 　　Next End Sub とすれば取得できるのはわかりますが、こんなまだるっこい方法以外に簡単に一番左の可視シート名を取得する方法はないでしょうか？ （＾∇＾）？ ご教示くださいませ。

  • ■シートを一つ削除するマクロを教えてください。

    前に、http://oshiete1.goo.ne.jp/qa4352149.html で質問させて頂きました。 その節は、お世話になりありがとうございました。 今回は、前回と似たようなものですが、 少々条件を変更したマクロを作成したいので ご協力のほど、何卒よろしくお願い致します。 文末にマクロを記述いたしますが、そちらは、 指定した日付以降にエクセルのファイルを開くと シートがすべて削除されて、「有効期限切れ」という シートだけが出てくるというものです。 今度は例えば「SheetA」、「SheetB」、「SheetC」という 3つのシートがあったとして、 指定した期日が来たら、「SheetC」だけを削除したいのです。 条件があり、「SheetC」は、マクロを有効にしないと使用できないようにしたいのです。 やり方をご存知の方、ご教示のほど 何卒よろしくお願い致します。 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) endsheetname = "有効期限切れ" If (Sheets.Count = 1) And (Sheets(1).Name = endsheetname) Then Exit Sub If Sheets("SheetA ").Visible Then Sheets("SheetC ").Visible = xlVeryHidden End Sub Private Sub Workbook_Open() endsheetname = "有効期限切れ" If Date >= "3008/09/29" Then Application.DisplayAlerts = False If Sheets.Count = 1 Then If Sheets(1).Name <> endsheetname Then Sheets.Add(After:=ActiveSheet).Name = endsheetname End If Else On Error Resume Next Sheets(endsheetname).Delete On Error GoTo 0 Sheets.Add(After:=ActiveSheet).Name = endsheetname End If sheetnumber = Sheets.Count For i = 1 To sheetnumber For j = 1 To 2 If Sheets.Count = 1 Then Exit For If Sheets(j).Name = " SheetC " Then If Not Sheets("SheetC ").Visible Then Sheets("SheetC ").Visible = True If Sheets(j).Name <> endsheetname Then Sheets(Sheets(j).Name).Delete: Exit For Next Next Range("b" & 3).Value = "ご利用ありがとうございました。" ActiveWorkbook.Save Application.DisplayAlerts = True End If If (Sheets.Count = 1) And (Sheets(1).Name = endsheetname) Then Exit Sub If Not Sheets(" SheetC ").Visible Then Sheets(" SheetC ").Visible = True End Sub

  • エクセルマクロで教えてください

    マクロ初心者です。アドバイスをお願いします。以下のマクロですとB列の100行目までの塗りつぶしのセルのカウントは出来るのですが、シート上の全てをカウントしたいのです。１TO 100の100の部分をどう変更したら良いのか教えてください。 Sub セルの色数1() Dim I As Integer Dim Count As Integer Count = 0 For I = 1 To 100 If Cells(I, 2).Interior.ColorIndex <> xlNone Then Count = Count + 1 Next I Range("C1").Value = Count End Sub

  • エクセル、ワークシートが保護されているかどうかを判断するVBAは？

    以下のように書いてもダメでした。 どう直せばよいでしょうか？ Sub TEST2() Dim n As Integer n = ThisWorkbook.Worksheets.Count For i = 1 To n If Worksheets(i).Protect = False Then MsgBox Worksheets(i).Name End If Next End Sub

  • シート名をループに

    質問を簡単にする為に以下のマクロがあるとします。 シート名が1～31とあるのですが、これをfor loopで 使うにはinteger等の定義が違うのでしょうか。 Sub bbb() Dim ws As Worksheet Dim 曜日 As String Dim i As Integer For Each ws In Worksheets For i = 1 To 31 If ws.Name = i Then　　<----------ここでエラー 　（コマンド) End If Next i Next End Sub

  • VBAで複数のシート名を置換する処理

    Dim ws As Worksheet Dim i As Long For i = 1 To ThisWorkbook.Sheets.Count For Each ws In ThisWorkbook.Sheets If ws.name Like "*T*" Then ws.name = Replace(ws.name, "T", "S") End If Next Next End Sub この処理をするとnameメソッド失敗worksheetオブジェクト 処理できるようにするにはどうすればいいんでしょうか

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する