配列のフィルターで指定日の前、或いは後のみのレコードを残す、または削除する

9ヶ月ほど前に、配列を編集する自作のクラスモジュールを纏めてみた。
infoment.hatenablog.com

その後、業務などで頻繁に使用しているうちに、幾つか修正点が出てきた。
前回に引き続き今回も、その中の一つをご紹介。
f:id:Infoment:20200629214702p:plain

前回紹介した「RowFilte」について、職場でこんなコメントが寄せられた。

『6/1より前』みたいな抽出の仕方はできませんか?

実はRowNumericFilter関数というものを別で作成していたのだが、名前が示す通り「Numeric(数値)」に限定していた。このままでは使えない。

ということで、作成者の特権とばかり、対象範囲を日付にまで拡張してみた。

といっても、大したことはしていない。IsNumericで数値判定してNGになる前に、IsDateで評価して拾うだけ。実際は、二値を比較する↓こちらを少しだけ改修。

' 大小比較用
Enum HighOrLow
    hlMore  ' 以上
    hlLess  ' 以下
    hlAbobe ' 超
    hlBelow ' 未満
End Enum
Private Function CompareResultValue(ByVal val1 As Variant, _
                                    ByVal val2 As Variant, _
                                    rf_type As HighOrLow, _
                                    rf_result As RemainOrDelete) As Boolean

    ' 初期値。
    CompareResultValue = False

    ' 数値か否かを確認。
    If IsNumeric(val1) = False Or IsNumeric(val2) = False Then
    
    ' -----------------↓今回追加↓-----------------
    
    ' 日付か否かを確認。
        If IsDate(val1) = False Or IsDate(val2) = False Then
            Exit Function
        End If

    ' -----------------↑今回追加↑-----------------

    End If
    
    ' 大小比較。
    Select Case rf_result
        ' 残す場合。
        Case RemainOrDelete.rdRemain
            Select Case rf_type
                ' 以上の場合。
                Case HighOrLow.hlMore
                    If val1 >= val2 Then CompareResultValue = True
                ' 超える場合。
                Case HighOrLow.hlAbobe
                    If val1 > val2 Then CompareResultValue = True
                ' 以下の場合。
                Case HighOrLow.hlLess
                    If val1 <= val2 Then CompareResultValue = True
                ' 未満の場合。
                Case HighOrLow.hlBelow
                    If val1 < val2 Then CompareResultValue = True
            End Select
        
        
        ' 消す場合。※残す場合と逆の条件になる。
        Case RemainOrDelete.rdDelete
            Select Case rf_type
                ' 以上の場合。
                Case HighOrLow.hlMore
                    If val1 < val2 Then CompareResultValue = True
                ' 超える場合。
                Case HighOrLow.hlAbobe
                    If val1 <= val2 Then CompareResultValue = True
                ' 以下の場合。
                Case HighOrLow.hlLess
                    If val1 > val2 Then CompareResultValue = True
                ' 未満の場合。
                Case HighOrLow.hlBelow
                    If val1 >= val2 Then CompareResultValue = True
            End Select
    End Select
            
End Function

それでは、毎度の「なんちゃって個人情報」で今回も確認してみよう。

Sub test()
    ' 名簿格納用配列。
    Dim arr As Variant
    
    ' テーブル(なんちゃって個人情報)。
    Dim Tb As Excel.ListObject
    Set Tb = ActiveSheet.ListObjects(1)

        With New ArrayEdit
            ' テーブル全体を、元となる配列に格納する。
            .source_array = Tb.Range
            
            ' 誕生日が1970年1月1日以降のデータのみ抽出する。
            arr = .RowNumericFilter(filt:=CDate("1970/1/1"), _
                                    column_index:=Tb.ListColumns("誕生日").Index, _
                                    rf_type:=hlMore, _
                                    rf_header:=xlYes, _
                                    rf_result:=rdRemain)
            
            ' 抽出後の配列を、新たに作成したシート「テスト」のA1に貼り付けてテーブル化。
            .source_array = arr
            .PasteArray "A1", "テスト", , , ptTable, True
        End With
End Sub

結果、指定日以降の誕生日のみに絞り込むことが出来た。
f:id:Infoment:20200629220127p:plain

前回同様、少なくとも個人的には、用途の幅が広がりそうです。

参考まで。