配列のフィルターで指定日の前、或いは後のみのレコードを残す、または削除する
9ヶ月ほど前に、配列を編集する自作のクラスモジュールを纏めてみた。
infoment.hatenablog.com
その後、業務などで頻繁に使用しているうちに、幾つか修正点が出てきた。
前回に引き続き今回も、その中の一つをご紹介。
前回紹介した「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
結果、指定日以降の誕生日のみに絞り込むことが出来た。
前回同様、少なくとも個人的には、用途の幅が広がりそうです。
参考まで。