Sheetの並び替えマクロを紹介します
マクロコードも紹介しています
使用方法解説動画↓
こんな時に使えます↓
同僚が作ったエクセルファイルやお得意さまから送られたファイル
いくつものSheetがあり整理されてなくて仕事の効率が落ちるからSheetの整理をします
けどエクセルにはSheetの並び替え(ソート)機能がないから、手作業で並び替えして「無駄作業~」ってなるけど作業を効率化させるために渋々やる
そんなときに一瞬でSheetの並び替えをしてくれるマクロを作りました
このマクロを使って、1分でも早く仕事を終わらせましょう
目指せ定時退社!
※並び替えは「あいうえお順」にはできません
数字やアルファベット順に対応しています
マクロコード
※マクロを入れる場合、EXCELファイルをマクロ形式にしてください
その後、Alt+F11でマクロの画面に移り変わるので、Alt+I+Mを押して
表示した画面にコピペしてください
下の記事にマクロの取り込み方法をまとめたのでよかったら参考にしてください
Sub Sheet並び替え()
'変数/////////////////////////////////
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws_sum As Long 'Sheetの合計変数
Dim ws_name1 As String 'Sheet名1用変数
Dim ws_name2 As String 'Sheet名2用変数
Dim sort_count '並び変える回数用変数
Dim i As Long 'カウンター変数
Dim msg As Long 'メッセージBOX用変数
'昇順・降順の確認/////////////////////////
msg = MsgBox("[はい]=昇順" & vbCrLf & vbCrLf & "[いいえ]=降順", vbYesNoCancel) 'msgboxの回答を変数に代入
ws_sum = wb.Sheets.Count 'Sheets数をカウント
If msg = 6 Then '[はい]=昇順
'Sheet昇順sort////////////////////////////
Do While sort_count <> ws_sum 'Sheet数と同じ回数分ループ処理
For i = 1 To ws_sum - 1
ws_name1 = wb.Sheets(i).Name 'Sheet名を代入
ws_name2 = wb.Sheets(i + 1).Name '該当の隣のSheet名を代入
If ws_name1 > ws_name2 Then 'Sheet名の比較
wb.Sheets(i).Move After:=wb.Sheets(i + 1) 'Sheetの移動
End If
Next i
sort_count = sort_count + 1 'ソートした回数をプラス
Loop
ElseIf msg = 7 Then '[いいえ]=降順
'Sheet降順sort////////////////////////////
Do While sort_count <> ws_sum
For i = 1 To ws_sum - 1
ws_name1 = wb.Sheets(i).Name 'Sheet名を代入
ws_name2 = wb.Sheets(i + 1).Name '該当の隣のSheet名を代入
If ws_name1 < ws_name2 Then 'Sheet名の比較
wb.Sheets(i).Move After:=wb.Sheets(i + 1) 'Sheetの移動
End If
Next i
sort_count = sort_count + 1 'ソートした回数をプラス
Loop
End If
End Sub
コメント