VBA DateSerial関数とバブルソートを使ってシートを古い順に並び替える

VBAによるプログラミングで、DateSerial関数とバブルソートを使ってエクセルのシートを並び替える方法を解説します。一見難しそうな処理も一工夫することで解決する実例を見ていきます。大抵のことはできる、という意識が大切です。

目次

DateSerial関数とバブルソートを使ってシートを古い順に並び替える

DateSerial関数とバブルソートを使ってエクセルのシートを並び替える方法を具体例を挙げて解説します。

今回の題材の概要

フォルダ内をループして必要なブックを取得し、ひとつのブックに集約したという場面を想定します。そして、それぞれのシートはその月の売上実績データが入っています。

シート名は現在このようになっています。

2018/10～2019/9のシートが順不同の順で並んでいるイメージ

それぞれのシート名は、月を英語3文字で表す文字列 & 半角スペース & 年を表す4桁の数字、MMM YYYYとなっており、古い順に並び替えると言うのが、今回やりたいことです。

DateSerial関数とFormat関数を使ってシート名をYYYYMMにする

シートをシート名が意味する年月が古い順に並び替えたいのですが、このままではどれが古いのがわかりません。そこで、MMM YYYYの表記をYYYYMMの６桁表記にします。まず、MMの表記にするためにMMMをSelect~Case文を使って数字に置き換えます。

これをFunctionプロシジャとして作成します。Functionプロシジャは自分で関数を作る事ができるイメージです。Jan 2019なら201901を返す関数を自作する、と言う具合です。

Private Function シート別名int(本来のシート名str As String) As Long
    
    Dim MMMstr As String　’Sepなど月を表す3文字を格納する
　Dim yyyy As Long      '2019など年を表す4文字を格納する
    Dim M As Long　　　’月を表す1文字を入れる
    
    MMMstr = Left(本来のシート名str, 3) 'シート名の左3文字を持ってくる
　yyyy = Right(本来のシート名str, 4)
    
    Select Case MMMstr
        Case "Jan"
            M = 1
        Case "Feb"
            M = 2
        Case "Mar"
            M = 3
        Case "Apr"
            M = 4
        Case "May"
            M = 5
        Case "Jun"
            M = 6
        Case "Jul"
            M = 7
        Case "Aug"
            M = 8
        Case "Sep"
            M = 9
        Case "Oct"
            M = 10
        Case "Nov"
            M = 11
        Case "Dec"
            M = 12
    End Select
    
    シート別名int = Format(DateSerial(yyyy, M, 1), "YYYYMM")

End Function

DateSerial関数は年、月、日を表す3つの値を順に引数にとり、日付型の値を生成することができます。例えば2019、1、1という3つの値を引数として渡すと2019/1/1を返します。

Format関数を使っているのは、月を表す数字が一桁の場合に0で埋めて、月の表示を2桁に合わせるためです。Jan 2019なら20191ではなく201901を返すためにこのようにします。2019/1/1をYYYYMMの形式で返すようにして、それをFunctionプロシジャの戻り値とするようにしています。

YYYYMMと6桁にそろえることによって、単に数値の大小を比較することで古い順に並び替えることができます。YYYYMMの書式にするためにRight(本来のシート名str, 4)とMと1をDateSerial関数に入れてから、Format関数に入れています。

DateSerialとFormat関数を組み合わせて使う方法は、VBA Dateserial関数とFormat関数を使って日付を自在に操るで詳しく解説しています。

Functionプロシジャができたので、このFunctionプロシジャを使うメイン部分を作っていきます。
シート名を勝手に置き換えるとユーザーが戸惑うかもしれないので、最後にはシート名を戻す必要があります。

そこで、対応表を作っておきます。イメージはワークシートのA列に元のシート名、B列に6桁に変換した数字を入れる感じですが、本当にシートに書き込むわけに行かないので、配列を使います。

Sub 古い順にシートを並び替える()

    Dim ws As Worksheet
    Dim 変換arr() As Variant　’対応表のために用意
    Dim シート数num As Long
    
    シート数num = Sheets.Count
    ReDim 変換arr(Sheets.Count - 1, 1)　’配列は0から始まるので、シート数を確保するインデックス番号はシート数－1
    
    Dim i As Long '変換arrの第カウントアップ用
    i = 0
    
    For Each ws In Worksheets
        
        変換arr(i, 0) = ws.Name
        変換arr(i, 1) = シート別名int(ws.Name)
        ws.Name = シート別名int(ws.Name)
        i = i + 1

    Next ws
    
End Sub

これで、シート名の変換ができました。一旦ファイルを保存してテストします。

実行結果

バブルソートの考え方

バブルソートは最も理解が容易なソート方法です。エクセルにはソート機能やオートフィルターのソート機能があり、シート上の値は大小に応じて降順に並び替える事ができます。そのため、バブルソートのようなアルゴリズムを知らなくても普段困る事はあまりありません。

しかし、今回はシートを並び替えるため、これらの機能が使えません。そこで、バブルソートと言う手法でシート名の日付を表す６桁の数値を比較して、シートを古い順に並び替えます。

バブルソートの考え方は簡単です。今回は一番左から一番右のひとつ手前のシートまで下記を繰り返します。

1. 右隣のシート名の値と比べる
2. 右隣の値の方が小さければ右隣のシートを、今のシートの左に持ってくる。大きければそのまま

この1と2の作業を左に持ってくる作業がなくなるまで繰り返せば左から小さい順に並び替える事ができます。

バブルソートの実装

それでは実装していきます。先ほどの「Sub 古い順にシートを並び替える()」の下に下記のコードを追記します。

    'ここから追記。右隣のシートと比較して、右側のシート名の数字が小さければ左に持ってくる。それを繰り返す

    Dim 入れ替えありbl As Boolean
    Dim j As Long 'シートのインデックス番号のカウントアップ用
    
    Do
        入れ替えありbl = False '初期化
        
        '右と比べて右の方が小さければ左に持ってくる
        For j = 1 To Sheets.Count - 1
            If Sheets(j).Name > Sheets(j + 1).Name Then
                Sheets(j + 1).Move before:=Sheets(j)
                入れ替え入れ替えありbl = True
            End If
        Next j
        
        'シート順の入れ替えが無くなったら終わり
        If Not 入れ替えありblAs Then
            Exit Do
        End If
        
    Loop

最後にシート名を戻しておく

このままではシート名が変わったままであるため、最後にシート名を元に戻しておきます。それぞれのシート名を配列内で検索して持ってきます。下記のコードをLoopの下に追記します。

    'シート名を戻す
    Dim k As Long '配列内のカウントアップ用
    
    For Each ws In Worksheets
        For k = LBound(変換arr, 1) To UBound(変換arr, 1)
            If ws.Name = 変換arr(k, 1) Then
                ws.Name = 変換arr(k, 0)
                Exit For
            End If
        Next k
    Next ws

ここまで書けたらSubプロシジャを実行します。

実行結果。古い順に並べ替えた上でちゃんと元の表記に戻っている。

いかがでしょうか。一見無理そうな自動化も工夫次第でなんとかなるものです。既に知っている関数やステートメントの知識をフルにいかすためにも、絶対何とかする方法があるはず、と言う目で、処理したい内容を見て実現方法を考えてみるようにしましょう。

DateSerial関数とバブルソートまとめ

この記事のポイントをまとめます。

• DateSerialを使うと

＜関連記事＞

• VBA 高速化 | ループ検索の速度を上げる方法(バイナリーサーチ)
• 3分で分かるロジックとアルゴリズムの違い