VBAでシートを昇順や降順で並び替える

シートを並べ替えるには

シートを並べ替えるにはシートのMoveメソッドを利用します。元のシート名の一覧を昇順や降順で並べて、その順番にMoveメソッドで配置しなおす手順になります。

シートのMoveメソッドの詳細については「VBAでシートの移動を行う」をご参照ください。

シート名の昇順や降順を行う方法にはいくつかありますが、ここではVBAだけで完結する配列のソートを使った方法を紹介します。

処理概要は以下になります。

全シートの名前を配列に格納する。
配列を昇順または降順に並べなおす。
配列の順序に沿ってMoveメソッドでシートの順番を並べなおす。

ソート処理はバブルソートで実装しています。

ソース構成

以下に５つの関数があります。

No	関数名	概要
1	bubbleSort	バブルソート（昇順）
2	bubbleSortDsc	バブルソート（降順）
3	RearrangeSheets	配列の順にシートを並べなおす
4	SheetAsc	シート整列（昇順）
5	SheetDsc	シート整列（降順）

１、２、３番目の関数は４、５番目から呼び出される関数で単独では動作しません。

４番目のSheetAsc関数を実行するとシートが昇順に、５番目のSheetDsc関数を実行すると降順に整列します。

3番目のRearrangeSheetsは昇順と降順で共用していますが、他の関数は昇順用と降順用に分けています。

昇順と降順の関数のそれぞれ黄色の部分が相違点です。必要であれば昇順と降順の関数は引数で共通化してください。ここではあえて共通化していません。

ちょっとした注意点ですが、90行目と111行目のループ処理ではSheetsコレクションを利用しています。ほとんどの場合はWorksheetsコレクションでも問題ありませんが、グラフシートやダイアログシートを利用している場合はWorksheetsコレクションには含まれませんのでその考慮が必要です。

'// バブルソート（昇順）
Sub bubbleSort(a_Ar)
    Dim i, ii               '// ループカウンタ
    Dim iArCnt              '// 配列の要素数
    Dim iArCnt2             '// 配列の要素数
    Dim v                   '// 一時保存用
    
    '// 配列の要素数を取得
    iArCnt = UBound(a_Ar)
    iArCnt2 = iArCnt
    
    i = 0
    
    '// 配列要素数ループ（全要素）
    Do While (i < iArCnt)
        ii = 0
        '// 配列要素数ループ（大小比較）
        Do While (ii < iArCnt2) 
            '// 現ループの内容が次ループ時の内容より大きい場合
            If (a_Ar(ii) > a_Ar(ii + 1)) Then
                '// 小さい順に並べなおす
                v = a_Ar(ii)                '// 現ループの大きい値を一時保存
                a_Ar(ii) = a_Ar(ii + 1)     '// 次ループの小さい値を現ループ値にセット
                a_Ar(ii + 1) = v            '// 次ループに現ループの値をセット
            End If
            
            ii = ii + 1
        Loop
        
        '// 最大値が確定したため未確定部分のみループするようにカウンタを減らす
        iArCnt2 = iArCnt2 - 1
        
        i = i + 1
    Loop
End Sub

'// バブルソート（降順）
Sub bubbleSortDsc(a_Ar)
    Dim i, ii               '// ループカウンタ
    Dim iArCnt              '// 配列の要素数
    Dim iArCnt2             '// 配列の要素数
    Dim v                   '// 一時保存用
    
    '// 配列の要素数を取得
    iArCnt = UBound(a_Ar)
    iArCnt2 = iArCnt
    
    i = 0
    
    '// 配列要素数ループ（全要素）
    Do While (i < iArCnt)
        ii = 0
        '// 配列要素数ループ（大小比較）
        Do While (ii < iArCnt2)
            '// 現ループの内容が次ループ時の内容より小さい場合
            If (a_Ar(ii) < a_Ar(ii + 1)) Then
                '// 大きい順に並べなおす
                v = a_Ar(ii + 1)        '// 次ループの大きい値を一時保存
                a_Ar(ii + 1) = a_Ar(ii) '// 現ループの小さい値を現ループ値にセット
                a_Ar(ii) = v            '// 現ループに次ループの値をセット
            End If
            
            ii = ii + 1
        Loop
        
        '// 最小値が確定したため未確定部分のみループするようにカウンタを減らす
        iArCnt2 = iArCnt2 - 1
        
        i = i + 1
    Loop
End Sub

'// 配列の順にシートを並べなおす
Sub RearrangeSheets(ar())
    Dim i
    
    '// 全シートループ
    For i = 1 To Sheets.Count
        '// シートを移動
        Call Sheets(ar(i - 1)).Move(Before:=Sheets(i))
    Next
End Sub

'// シート整列（昇順）
Sub SheetAsc()
    Dim ar()
    Dim i
    
    '// 配列領域を確保
    ReDim ar(Sheets.Count - 1)
    
    For i = 1 To Sheets.Count
        ar(i - 1) = Sheets(i).Name
    Next
    
    '// 昇順ソート
    Call bubbleSort(ar)
    
    '// シート名再設定
    Call RearrangeSheets(ar)
End Sub

'// シート整列（降順）
Sub SheetDsc()
    Dim ar()
    Dim i
    
    '// 配列領域を確保
    ReDim ar(Sheets.Count - 1)
    
    For i = 1 To Sheets.Count
        ar(i - 1) = Sheets(i).Name
    Next
    
    '// 降順ソート
    Call bubbleSortDsc(ar)
    
    '// シート名再設定
    Call RearrangeSheets(ar)
End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

'// バブルソート（昇順）

Sub bubbleSort(a_Ar)

Dim i, ii '// ループカウンタ

Dim iArCnt '// 配列の要素数

Dim iArCnt2 '// 配列の要素数

Dim v '// 一時保存用

'// 配列の要素数を取得

iArCnt = UBound(a_Ar)

iArCnt2 = iArCnt

i = 0

'// 配列要素数ループ（全要素）

Do While (i < iArCnt)

ii = 0

'// 配列要素数ループ（大小比較）

Do While (ii < iArCnt2)

'// 現ループの内容が次ループ時の内容より大きい場合

If (a_Ar(ii) > a_Ar(ii + 1)) Then

'// 小さい順に並べなおす

v = a_Ar(ii) '// 現ループの大きい値を一時保存

a_Ar(ii) = a_Ar(ii + 1) '// 次ループの小さい値を現ループ値にセット

a_Ar(ii + 1) = v '// 次ループに現ループの値をセット

End If

ii = ii + 1

Loop

'// 最大値が確定したため未確定部分のみループするようにカウンタを減らす

iArCnt2 = iArCnt2 - 1

i = i + 1

Loop

End Sub

'// バブルソート（降順）

Sub bubbleSortDsc(a_Ar)

Dim i, ii '// ループカウンタ

Dim iArCnt '// 配列の要素数

Dim iArCnt2 '// 配列の要素数

Dim v '// 一時保存用

'// 配列の要素数を取得

iArCnt = UBound(a_Ar)

iArCnt2 = iArCnt

i = 0

'// 配列要素数ループ（全要素）

Do While (i < iArCnt)

ii = 0

'// 配列要素数ループ（大小比較）

Do While (ii < iArCnt2)

'// 現ループの内容が次ループ時の内容より小さい場合

If (a_Ar(ii) < a_Ar(ii + 1)) Then

'// 大きい順に並べなおす

v = a_Ar(ii + 1) '// 次ループの大きい値を一時保存

a_Ar(ii + 1) = a_Ar(ii) '// 現ループの小さい値を現ループ値にセット

a_Ar(ii) = v '// 現ループに次ループの値をセット

End If

ii = ii + 1

Loop

'// 最小値が確定したため未確定部分のみループするようにカウンタを減らす

iArCnt2 = iArCnt2 - 1

i = i + 1

Loop

End Sub

'// 配列の順にシートを並べなおす

Sub RearrangeSheets(ar())

Dim i

'// 全シートループ

For i = 1 To Sheets.Count

'// シートを移動

Call Sheets(ar(i - 1)).Move(Before:=Sheets(i))

End Sub

'// シート整列（昇順）

Sub SheetAsc()

Dim ar()

Dim i

'// 配列領域を確保

ReDim ar(Sheets.Count - 1)

For i = 1 To Sheets.Count

ar(i - 1) = Sheets(i).Name

'// 昇順ソート

Call bubbleSort(ar)

'// シート名再設定

Call RearrangeSheets(ar)

End Sub

'// シート整列（降順）

Sub SheetDsc()

Dim ar()

Dim i

'// 配列領域を確保

ReDim ar(Sheets.Count - 1)

For i = 1 To Sheets.Count

ar(i - 1) = Sheets(i).Name

'// 降順ソート

Call bubbleSortDsc(ar)

'// シート名再設定

Call RearrangeSheets(ar)

End Sub

使い方

元のシートの並びがこのようになっているとします。
Sheet5、2、1、4、3、7、6です。

その場合に昇順用のSheetAsc関数を実行すると以下に整列します。
Sheet1、2、3、4、5、6、7

また、降順用のSheetDsc関数を実行すると以下に整列します。
Sheet、7、6、5、4、3、2、1

また、シートが１つしか無い場合もエラーにならず正しく動作します。

シートを並べ替えるには

ソース構成

使い方

関連記事