Excelのワークシートとグラフシートを効率的に並べ替える方法

Excelのワークブックには、通常、複数のワークシートとグラフシートが含まれています。これらのシートを手動で並べ替えることは、非常に時間がかかり、エラーが発生する可能性があります。この記事では、Excel VBAを使用してワークシートとグラフシートを効率的に並べ替える方法について説明します。

このコードは何ができるのか
どんなシーンで役に立つのか
マクロのコード
マクロの使い方
まとめ

このコードは何ができるのか

このVBAマクロは、ワークブック内のワークシートとグラフシートを並べ替えるために使用されます。ユーザーは、昇順または降順でシートを並べ替えることができます。また、ワークシートとグラフシートを一緒に並べ替えるか、ワークシートを先に並べ替えてからグラフシートを並べ替えるか、逆にグラフシートを先に並べ替えてからワークシートを並べ替えるかを選択することができます。

どんなシーンで役に立つのか

このマクロは、以下のようなシーンで役立ちます。

大量のデータを分析し、結果をグラフで表示する場合。このマクロを使用すると、データとグラフを効率的に整理できます。
複数のユーザーが同じワークブックを使用し、シートの順序が頻繁に変更される場合。このマクロを使用すると、シートの順序を簡単にリセットできます。

マクロのコード

以下のコードをVBAエディタより標準モジュールへ貼り付けてください。

VBAエディタはAlt+F11キーで起動します。空の標準モジュールは「挿入→標準モジュール」で作成されます。貼り付け後はVBAエディタは閉じてブックへ戻ります。

Sub SortSheets()
    Dim i As Integer
    Dim j As Integer
    Dim sortOrder As Variant
    Dim sheetOrder As Variant
    
    ' Get user input for sort order and sheet order
    sortOrder = InputBox("昇順は1、降順は0を入力してください:", "並べ替え順序", 1)
    If sortOrder = "" Then
        MsgBox "並べ替えを中断しました"
        Exit Sub
    End If
    sheetOrder = InputBox("ワークシートとグラフシートを一緒に並べ替える場合は0、ワークシートを先に並べ替える場合は1、グラフシートを先に並べ替える場合は2を入力してください:", "シートの並べ替え順序", 0)
    If sheetOrder = "" Then
        MsgBox "並べ替えを中断しました"
        Exit Sub
    End If
    
    ' Sort the sheets by name
    For i = 1 To ThisWorkbook.Sheets.Count
        For j = i + 1 To ThisWorkbook.Sheets.Count
            If sortOrder = 0 Then
                If ThisWorkbook.Sheets(j).Name > ThisWorkbook.Sheets(i).Name Then
                    Sheets(j).Move Before:=Sheets(i)
                End If
            Else
                If ThisWorkbook.Sheets(j).Name < ThisWorkbook.Sheets(i).Name Then Sheets(j).Move Before:=Sheets(i) End If End If Next j Next i ' Reorder the sheets based on the sheet order If sheetOrder = 1 Then ' Move all chart sheets to the end For i = ThisWorkbook.Sheets.Count To 1 Step -1 If TypeName(Sheets(i)) = "Chart" Then Sheets(i).Move After:=Sheets(ThisWorkbook.Sheets.Count) End If Next i ' Sort worksheets For i = 1 To ThisWorkbook.Sheets.Count If TypeName(Sheets(i)) = "Worksheet" Then For j = i + 1 To ThisWorkbook.Sheets.Count If TypeName(Sheets(j)) = "Worksheet" Then If sortOrder = 0 Then If Sheets(j).Name > Sheets(i).Name Then
                                Sheets(j).Move Before:=Sheets(i)
                            End If
                        Else
                            If Sheets(j).Name < Sheets(i).Name Then Sheets(j).Move Before:=Sheets(i) End If End If End If Next j End If Next i ' Sort chart sheets For i = 1 To ThisWorkbook.Sheets.Count If TypeName(Sheets(i)) = "Chart" Then For j = i + 1 To ThisWorkbook.Sheets.Count If TypeName(Sheets(j)) = "Chart" Then If sortOrder = 0 Then If Sheets(j).Name > Sheets(i).Name Then
                                Sheets(j).Move Before:=Sheets(i)
                            End If
                        Else
                            If Sheets(j).Name < Sheets(i).Name Then Sheets(j).Move Before:=Sheets(i) End If End If End If Next j End If Next i ElseIf sheetOrder = 2 Then ' Move all worksheets to the end For i = ThisWorkbook.Sheets.Count To 1 Step -1 If TypeName(Sheets(i)) = "Worksheet" Then Sheets(i).Move After:=Sheets(ThisWorkbook.Sheets.Count) End If Next i ' Sort chart sheets For i = 1 To ThisWorkbook.Sheets.Count If TypeName(Sheets(i)) = "Chart" Then For j = i + 1 To ThisWorkbook.Sheets.Count If TypeName(Sheets(j)) = "Chart" Then If sortOrder = 0 Then If Sheets(j).Name > Sheets(i).Name Then
                                Sheets(j).Move Before:=Sheets(i)
                            End If
                        Else
                            If Sheets(j).Name < Sheets(i).Name Then Sheets(j).Move Before:=Sheets(i) End If End If End If Next j End If Next i ' Sort worksheets For i = 1 To ThisWorkbook.Sheets.Count If TypeName(Sheets(i)) = "Worksheet" Then For j = i + 1 To ThisWorkbook.Sheets.Count If TypeName(Sheets(j)) = "Worksheet" Then If sortOrder = 0 Then If Sheets(j).Name > Sheets(i).Name Then
                                Sheets(j).Move Before:=Sheets(i)
                            End If
                        Else
                            If Sheets(j).Name < Sheets(i).Name Then
                                Sheets(j).Move Before:=Sheets(i)
                            End If
                        End If
                    End If
                Next j
            End If
        Next i
    End If
    
    ' Select the first sheet
    ThisWorkbook.Sheets(1).Select
End Sub