Mutable_Yunの業務改善ブログ

業務改善や生産性向上のブログです。自動化の手段として、VBAやRPAの勉強に役立つ解説をしています。

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

一見自動化が難しそうな処理があると、VBAで自動化をするのを諦めていませんか?今回は一工夫することで解決する実例を見ていきます。大抵のことはできますよ!


この記事は中級~上級です。
レベルについてはExcel VBAの実力(レベル)を定義してみる 初心者~三段をご参照ください。


目次

今回の題材の概要

フォルダ内をループして必要なブックを取得し、ひとつのブックに集約しました。

それぞれのシートはその月の売上実績データが入っています。

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

f:id:mutable_yun:20190914145715p:plain
2018/10~2019/9のシートが順不同の順で並んでいるイメージ

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

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

シートをシート名が意味する年月が古い順に並び替えたいのですが、このままではどれが古いのがわかりません。

そこで、MMM YYYYの表記をYYYYMMの6桁表記にします。

まず、MMの表記にするためにMMMをSelect~Case文を使って数字に置き換えます。
これをFunctionプロシジャとして作成します。

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


Format関数を使っているのは、月を表す数字が一桁の場合に0で埋めて、月の表示を2桁に合わせるためです。

YYYYMMの書式にするためにRight(本来のシート名str, 4)とMと1を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

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

f:id:mutable_yun:20190914162615p:plain
実行結果

バブルソートの考え方

バブルソートは最も理解が容易なソート方法です。エクセルにはソート機能やオートフィルターのソート機能があり、シート上の値は大小に応じて降順に並び替える事ができます。

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

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

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

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

バブルソートの実装

それでは実装していきます。先ほどの「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プロシジャを実行します。

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

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