'========================================================================================= ' 152 ハイフンで結ばれた数を並べ替える '----------------------------------------------------------------------------------------- '【ヒント】 ' このマクロは、おためし機能の動作用のコードを含んでいます。（概ね下半分） ' ★★★の行またはサブプロシージャーが、タイトル機能に関係するコードです。（概ね上半分） '========================================================================================= ' ◆標準モジュールのコード◆ '----------------------------------------------------------------------------------------- Option Explicit Dim 下端 As Long Dim タイトル As String Dim スタイル As Long Dim メッセージ As String Dim 応答 As Variant '========================================================================================= Private Sub ハイフンで結ばれた数を並べ替える() '★★★ 並べ替えるデータをソート前シートから作業シートに写す ハイフンの前後でデータを分ける数式を数式シートから作業シートに写す 作業シートでハイフンの前後の数字をキーにして並べ替える 並べ替えたデータを作業シートからソート後シートに写す End Sub '----------------------------------------------------------------------------------------- Private Sub 並べ替えるデータをソート前シートから作業シートに写す() 動作説明1を表示する Worksheets("作業").Cells.Clear 'クリアする Sheets("ソート前").Select 'データの入ったシートを選択する 下端 = Range("A1").End(xlDown).Row '下端検出 Range(Cells(1, 1), Cells(下端, 1)).Copy 'A列のデータをコピーする Windows("152.XLS:3").Activate 'おためし用のコードにつき本番では不要 Sheets("作業").Select '作業用のシートを選択する Range("A1").PasteSpecial Paste:=xlAll 'データをすべて貼り付ける End Sub '----------------------------------------------------------------------------------------- Private Sub ハイフンの前後でデータを分ける数式を数式シートから作業シートに写す() 動作説明2を表示する Sheets("数式").Select Range("B1:D2").Copy '列タイトルと式をコピーする Windows("152.XLS:3").Activate 'おためし用のコードにつき本番では不要 Sheets("作業").Select Range("B1").PasteSpecial Paste:=xlAll '列タイトルと式を貼り付ける ' Range("B2:D2").Copy 'コピーする Range(Cells(3, 2), Cells(下端, 4)).PasteSpecial Paste:=xlAll '貼り付ける End Sub '----------------------------------------------------------------------------------------- Private Sub 作業シートでハイフンの前後の数字をキーにして並べ替える() 動作説明3を表示する Sheets("作業").Select Range("A1").Select Selection.SortSpecial SortMethod:=xlSyllabary, Key1:=Range("C2"), _ Order1:=xlAscending, Key2:=Range("D2"), Order2:=xlAscending, _ Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation _ :=xlTopToBottom 'ソートする（第1キー：C列、第2キー：D列） End Sub '----------------------------------------------------------------------------------------- Private Sub 並べ替えたデータを作業シートからソート後シートに写す() 動作説明4を表示する Sheets("作業").Select Range(Cells(1, 1), Cells(下端, 1)).Copy 'ソート済みのデータをコピーする Windows("152.XLS:1").Activate 'おためし用のコードにつき本番では不要 Sheets("ソート後").Select Range("A1").PasteSpecial Paste:=xlAll 'データをすべて貼り付ける End Sub '========================================================================================= '----------------------------------------------------------------------------------------- Sub おためしマクロ() おためしメッセージを準備する ハイフンで結ばれた数を並べ替える '★★★ 動作説明5を表示する End Sub '----------------------------------------------------------------------------------------- Private Sub おためしメッセージを準備する() Worksheets("作業").Cells.Clear 'クリアする Worksheets("ソート後").Cells.Clear Worksheets("Title").Select Range("P17").Select 'カーソルを定位置へ移動する タイトル = "500連発 第2弾 サンプルマクロ" スタイル = 64 'vbInformation おためし用に画面でシートを一望できるようにする End Sub '----------------------------------------------------------------------------------------- Sub おためし用に画面でシートを一望できるようにする() ActiveWindow.WindowState = xlMaximized 'ウィンドウを最大化する Sheets("ソート後").Select ActiveWindow.NewWindow '新しいウィンドウを開く Sheets("数式").Select ActiveWindow.NewWindow Sheets("作業").Select ActiveWindow.NewWindow Windows.Arrange ArrangeStyle:=xlTiled 'ウィンドウを並べて表示する Worksheets("ソート前").Activate End Sub '----------------------------------------------------------------------------------------- Private Sub 動作説明1を表示する() Windows("152.XLS:4").Activate メッセージ = "並べ替えるデータを、左上の「ソート前」シートから、" & Chr(13) & Chr(13) & _ "左下の「作業」シートに写します" 応答 = MsgBox(メッセージ, スタイル, タイトル) End Sub '----------------------------------------------------------------------------------------- Private Sub 動作説明2を表示する() Windows("152.XLS:1").Activate Sheets("ソート後").Select Windows("152.XLS:2").Activate Range("B2:D2").Select メッセージ = "右上の「数式」シートには、" & Chr(13) & Chr(13) & _ "ハイフンの前後でデータを分ける数式が、入っています。" & Chr(13) & Chr(13) & _ "数式を、左下の「作業」シートに写します" 応答 = MsgBox(メッセージ, スタイル, タイトル) End Sub '----------------------------------------------------------------------------------------- Private Sub 動作説明3を表示する() Windows("152.XLS:1").Activate Sheets("ソート後").Select Windows("152.XLS:3").Activate メッセージ = "左下の「作業」シートで、" & Chr(13) & Chr(13) & _ "ハイフンの前後の数字をキーにして、並べ替えます" 応答 = MsgBox(メッセージ, スタイル, タイトル) End Sub '----------------------------------------------------------------------------------------- Private Sub 動作説明4を表示する() Windows("152.XLS:1").Activate Sheets("ソート後").Select Windows("152.XLS:3").Activate ' Sheets("ソート後").Select メッセージ = "左下の「作業」シートの並べ替えたデータを、" & Chr(13) & Chr(13) & _ "右下の「ソート後」シートに写します" 応答 = MsgBox(メッセージ, スタイル, タイトル) End Sub '----------------------------------------------------------------------------------------- Private Sub 動作説明5を表示する() メッセージ = "右下の「ソート後」シートが、並べ替えた結果です。" & Chr(13) & Chr(13) & _ "OKボタンをクリックすると、画面が戻ります。" 応答 = MsgBox(メッセージ, スタイル, タイトル) ' Windows("152.XLS:3").Close Windows("152.XLS:2").Close Windows("152.XLS:2").Close Sheets("Title").Select ActiveWindow.WindowState = xlMaximized End Sub '----------------------------------------------------------------------------------------- Sub Auto_Close() Application.DisplayAlerts = False '閉じる際に確認メッセージを出さない ActiveWorkbook.Close '現在開いているブックを閉じる End Sub '-----------------------------------------------------------------------------------------