38本目：1シートを複数シートに振り分け

Excel&VBA解説サイト「エクセルの神髄」様出題の問題集、
「VBA100本ノック」に対する私の回答と解説のページです。

100本ノックの出題リストはこちらから
excel-ubara.com

出題：1シートを複数シートに振り分け

#VBA100本ノック 38本目
「売上」シートのA列に日付が昇順で入っています。
土日祝と平日に分けて別シートに出力してください。
・「売上」シートの列数は不定。
・「土日祝」「平日」シートは既存です。
・祝日は「祝日」シートのA列にあります。
※セルの書式の扱いは任意

◇ 出題ページはこちら

ソースコード

メインモジュール

Option Explicit

' 100本ノック038：1シートを複数シートに振り分け
Sub 売上シートを土日祝と平日に分割する()

    ' 出力先シートの初期化
    Call 指定行より下をすべて削除する(WS平日, 2)
    Call 指定行より下をすべて削除する(WS土日祝, 2)

    Dim 表エリア As Range
    Set 表エリア = WS売上.Range("A1").CurrentRegion
    
    ' 平日/土日祝の判定作業列を挿入
    Dim C_計算列 As Long: C_計算列 = 表エリア.Columns.Count + 1
    WS売上.Columns(C_計算列).Insert
    WS売上.Cells(1, C_計算列) = "平日判定"

    Call フィルターを設置する(WS売上.Rows(1))
        
    ' シート数式で計算
    Call シート数式で計算する(GetRange指定列のデータ部分(WS売上, C_計算列) _
        , "=IF(OR(WEEKDAY(A2,2)<=5),ISERROR(MATCH(A2,祝日!A:A,0)))")
    
    ' 平日データの出力
    Call フィルターで抽出する(WS売上, C_計算列, True)
    If Countフィルター抽出中の件数(WS売上) >= 0 Then
        表エリア.Resize(表エリア.Columns.Count - 1).Copy WS平日.Range("A1")
    End If
    Call フィルターをクリアする(WS売上)
    
    ' 土日祝データの出力
    Call フィルターで抽出する(WS売上, C_計算列, False)
    If Countフィルター抽出中の件数(WS売上) >= 0 Then
        表エリア.Resize(表エリア.Columns.Count - 1).Copy WS土日祝.Range("A1")
    End If
    Call フィルターをクリアする(WS売上)
    
    ' 作業列の削除
    WS売上.Columns(C_計算列).Delete
    
End Sub

汎用関数モジュール

Option Explicit

' 指定行より下の削除
' 参考：https://www.limecode.jp/entry/utility/delete-rows-below-to-last
Sub 指定行より下をすべて削除する(対象シート As Worksheet, 指定行 As Long)
    With 対象シート
    
        Call フィルターをクリアする(対象シート)
        
        .Range(.Rows(指定行), .Rows(.Rows.Count)).Delete
        
    End With
End Sub

' フィルターの設置
' ◆ ブログ未掲載
Sub フィルターを設置する(設置エリア As Range)
    
    ' 既にあるフィルターを解除してから設置
    設置エリア.Worksheet.AutoFilterMode = False
    設置エリア.AutoFilter
    
End Sub

' フィルター抽出
Sub フィルターで抽出する(対象シート As Worksheet, 抽出列 As Long, ByVal 抽出キー As Variant)
    With 対象シート.AutoFilter.Range
    
        ' 数値が書式の影響を受けるのを回避
        If WorksheetFunction.IsNumber(抽出キー) Then
            .AutoFilter field:=抽出列 - .Column + 1, Criteria1:=">=" & 抽出キー _
                      , Operator:=xlAnd, Criteria2:="<=" & 抽出キー
        ' メインの処理
        Else
            .AutoFilter field:=抽出列 - .Column + 1, Criteria1:=抽出キー
        End If
    
    End With
End Sub

' フィルターのクリア
' ◆ ブログ未掲載
Sub フィルターをクリアする(対象シート As Worksheet)
    If 対象シート.AutoFilterMode = True Then
        If 対象シート.AutoFilter.FilterMode = True Then
            対象シート.AutoFilter.ShowAllData
        End If
    End If
End Sub

' データ件数
' ◆ ブログ未掲載
Function Countデータ件数(対象シート As Worksheet) As Long
    If 対象シート.AutoFilterMode = False Then Exit Function
    With 対象シート.AutoFilter.Range
        Countデータ件数 = .Rows.Count + .Row - 2
    End With
End Function

' 抽出件数のカウント
Function Countフィルター抽出中の件数(指定シート As Worksheet) As Long
    
    ' ◇ もともとデータが空のときは0(フィルター設置範囲が▼見出し1行だけのとき)
    If 指定シート.AutoFilter.Range.Rows.Count = 1 Then
        Countフィルター抽出中の件数 = 0
        Exit Function
    End If
    
    ' オートフィルター範囲1列目の可視セル数をカウント
    Countフィルター抽出中の件数 = 指定シート.AutoFilter.Range _
        .Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        
End Function

' 各列のデータ部分
' 参考：https://www.limecode.jp/entry/utility/get-column-data-range
Function GetRange指定列のデータ部分(対象シート As Worksheet, 対象列 As Long) As Range
    If Countデータ件数(対象シート) = 0 Then Exit Function
    Set GetRange指定列のデータ部分 = 対象シート.Cells(対象シート.AutoFilter.Range.Row + 1, 対象列) _
                                                            .Resize(Countデータ件数(対象シート))
End Function

' シート数式計算
' 参考：https://www.limecode.jp/entry/syntax/formula
Sub シート数式で計算する(計算エリア As Range, シート数式 As String)
    計算エリア.Formula = シート数式
    計算エリア.Value = 計算エリア.Value
End Sub

解説

データをキーごとにシート分割するおなじみの処理ですね。

今回は日付を平日/土日祝で分割する問題でした。

今回は分割キー自体をシート上に持っていないため、
祝日マスタを参照して作成する必要があります。

こういった計算はFormulaを使ってシート上で計算するのがおすすめで、

• 数式をシート上で書くことで結果をその場でテストできる
• 作業列を削除しなければデバッグに利用できる

というメリットが享受できます。

Formulaは処理速度も高速なので、積極的に使っていきましょう。

シートの分割はオートフィルターを使用しました。

抽出したデータのコピーが「フィルター範囲.Copy」で済んでしまうため、
条件判定が簡単な転記処理はかなりコーディング効率が良いです。

「Formulaで条件判定 ⇒ AutoFilterでシート分割」
という手法は非常に便利ですので使えるようになっておきましょう。