エクセル表のフィルター機能を自作してみようの会

## はじめに

エクセル表のデフォルト機能であるフィルターは検索効率が悪いと思ったので自作してみることにした。

### 今回の要点
1. 複数検索に対応する
2. AND検索OR検索を選択可能
3. 検索条件が簡単に確認可能 
4. 情報ソースと検索用のシートを別にする

デフォルト機能のフィルターでは瞬時に検索条件を確認することが困難であり、AND検索とOR検索の直感的な選択が困難。また、ソースデータのシートで検索作業をすると何かの手違いでデータを改変してしまったりする恐れがあるため、検索用シートを設けることにした。
なので今回はこの４点を要点に置いた。


シートの構造は以下を参考に。

*Sheet1*（ソースシート）
A列　⇒　日付（yyyy/mm/dd）
B列　⇒　ジャンル項目
C列　⇒　サブジャンル項目
D列　⇒　キーワード
（2行目以降に実際のデータ）

*Sheet2*（出力用シート）
A1　⇒　検索開始日（任意）
A2　⇒　検索最終日（任意）
B1　⇒　ジャンル条件（任意）
C1　⇒　サブジャンル条件（任意）
D1　⇒　キーワード条件（任意）
F1　⇒　検索方法（必須）←ANDまたはORのみ入力

3行目　⇒　カラム名
4行目以降　⇒　検索結果

### 1：全体像
まずは全体のプログラムから。

```vb
Option Explicit

Sub ExtractDataWithCondition()
    
    Dim srcWS As Worksheet, destWS As Worksheet

    Set srcWS = ThisWorkbook.Sheets("Sheet1")
    Set destWS = ThisWorkbook.Sheets("Sheet2")
    
     ' 条件入力値を格納する変数（必要に応じて追加）
     '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     Dim genreList() As String, subGenreList() As String, keywordList() As String
     
     Dim searchMode As String  ' 検索方法、基本いじらない（ANDまたはOR）
     '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     
     ' 各変数の取得セルを設定
     '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     Dim startDateRng As String: startDateRng = "A1" ' 取得開始日のセル指定
     Dim endDateRng As String: endDateRng = "A2" ' 取得終了日のセル指定
     
     Dim genreListRng As String: genreListRng = "B1" ' ジャンル
     Dim subGenreListRng As String: subGenreListRng = "C1" ' サブジャンル
     Dim keywordListRng As String: keywordListRng = "D1" ' キーワード
     
     Dim searchModeRng As String: searchModeRng = "F1" ' 検索モード
     '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     
     ' 配列化したデータを格納する変数（「、」区切り）（必要に応じて追加）
     '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     genreList = SplitCondition(destWS.Range(genreListRng).Value)
     subGenreList = SplitCondition(destWS.Range(subGenreListRng).Value)
     keywordList = SplitCondition(destWS.Range(keywordListRng).Value)
     
     searchMode = UCase(Trim(destWS.Range(searchModeRng).Value))
     '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     
     ' 検索方法が明記されているかチェック
     If searchMode <> "AND" And searchMode <> "OR" Then
        MsgBox "検索モード（" & searchModeRng & "セル）は「AND」または「OR」で指定してください。", vbExclamation
        Exit Sub
     End If
     
     
     ' 日付条件の取得
     Dim startDateSet As Boolean, endDateSet As Boolean
     Dim startDate As Date, endDate As Date
     
     ' 検索開始日を記入しているか
     If IsDate(destWS.Range(startDateRng).Value) Then
        startDate = CDate(destWS.Range(startDateRng).Value)
        startDateSet = True
    End If
    ' 検索最終日を記入しているか
    If IsDate(destWS.Range(endDateRng).Value) Then
        endDate = CDate(destWS.Range(endDateRng).Value)
        endDateSet = True
    End If
    ' 開始日時のみ記入ある場合
    If startDateSet And Not endDateSet Then
        endDate = Date: endDateSet = True ' 最終日を今日に設定
    ' 最終日時のみ記入ある場合
    ElseIf Not startDateSet And endDateSet Then
        startDate = DateSerial(1900, 1, 1): startDateSet = True ' 開始日を1900/1/1に設定
    End If
    
    ' 抽出処理
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Dim destStartRow As Long, srcStartRow As Long, srcLastRow As Long
    Dim destRow As Long ' for文で使う貼り付け行
    destStartRow = 4 ' 貼り付け先の開始行数
    srcStartRow = 2
    srcLastRow = srcWS.Cells(srcWS.Rows.Count, "A").End(xlUp).Row ' ソースページの最終行
    destRow = destStartRow ' 貼り付け先の行数（初期値は startRow と一致）
    
    destWS.Range("A" & destStartRow & ":Z10000").ClearContents
    
    Dim currentDate As Date
    Dim rowMatched As Boolean ' 条件に一致する行である場合は True を返す
    Dim i As Long
    For i = srcStartRow To srcLastRow
        ' 条件に一致する項目が見つかれば Ture を返す変数を作成
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim genreCond As Boolean, subGenreCond As Boolean, keywordCond As Boolean
        
        Dim dateCond As Boolean
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        
        ' 条件に当てはまる文字列があるか検査
        If searchMode = "AND" Then
            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            genreCond = IsAllMatch(srcWS.Cells(i, destWS.Range(genreListRng).Column).Value, genreList)
            subGenreCond = IsAllMatch(srcWS.Cells(i, destWS.Range(subGenreListRng).Column).Value, subGenreList)
            keywordCond = IsAllMatch(srcWS.Cells(i, destWS.Range(keywordListRng).Column).Value, keywordList)
            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Else
            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            genreCond = IsMatch(srcWS.Cells(i, destWS.Range(genreListRng).Column).Value, genreList)
            subGenreCond = IsMatch(srcWS.Cells(i, destWS.Range(subGenreListRng).Column).Value, subGenreList)
            keywordCond = IsMatch(srcWS.Cells(i, destWS.Range(keywordListRng).Column).Value, keywordList)
            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        End If
        
        ' 日付条件に当てはまるかチェック
        dateCond = False
        If startDateSet And endDateSet And IsDate(srcWS.Cells(i, Range(startDateRng).Column).Value) Then
            currentDate = CDate(srcWS.Cells(i, Range(startDateRng).Column).Value)
            dateCond = (currentDate >= startDate And currentDate <= endDate)
        End If
        
        If searchMode = "AND" Then
            ' AND検索：すべての条件を満たす必要あり
            rowMatched = True ' 初期値
            ' ※すべての条件が未記入の場合は全検索
            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            If UBound(genreList) >= 0 And Not genreCond Then rowMatched = False
            If UBound(subGenreList) >= 0 And Not subGenreCond Then rowMatched = False
            If UBound(keywordList) >= 0 And Not keywordCond Then rowMatched = False
            
            If (startDateSet Or endDateSet) And Not dateCond Then rowMatched = False
            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Else
            ' Or検索：いずれかのテキスト条件が一致+日付も一致していればヒット（※日付のみAND条件）
            Dim anyTextCond As Boolean
            anyTextCond = False
            
            ' テキスト条件のいずれか一致すればOK
            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            If UBound(genreList) >= 0 And genreCond Then anyTextCond = True
            If UBound(subGenreList) >= 0 And subGenreCond Then anyTextCond = True
            If UBound(keywordList) >= 0 And keywordCond Then anyTextCond = True
            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            
            Dim allTextEmpty As Boolean ' すべての検索項目が無記入の場合は True
            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            allTextEmpty = (UBound(genreList) < 0 And UBound(subGenreList) < 0 And UBound(keywordList) < 0)
            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            
            If allTextEmpty Then  ' テキスト条件がすべて空の場合の処理
                If startDateSet Or endDateSet Then
                    rowMatched = dateCond ' 日付だけで判定
                Else
                    rowMatched = True ' 日付含めすべて未記入の場合
                End If
            Else ' テキスト条件のいずれかに記入あり
                If anyTextCond Then
                    If startDateSet Or endDateSet Then
                        rowMatched = dateCond
                    Else ' 日付が未記入であればテキスト条件のみで判定
                        rowMatched = True
                    End If
                Else
                    rowMatched = False
                End If
            End If
        
        End If
        
        If rowMatched Then
            srcWS.Range("A" & i & ":D" & i).Copy destWS.Range("A" & destRow)
            destRow = destRow + 1
        End If
        
    Next i
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    destWS.Range("F" & destStartRow - 1).Value = destRow - destStartRow
    
    
End Sub

' 補助関数：条件文字列を配列に変換（空欄なら空配列に）
Function SplitCondition(inputStr As String) As String()
    ' 条件文字が入っていない場合の処理
    If Trim(inputStr) = "" Then
        ' 配列の数（最大インデックス）を-1にする。のちの処理に利用する。
        ReDim SplitCondition(-1 To -1)
    Else
        ' "," を "、"に置き換えてから配列化する
        SplitCondition = Split(Replace(inputStr, "，", "、"), "、")
    End If
End Function

' 補助関数：文字列(target)が文字列のリスト(conditions)に対して部分一致している場合は Trure を返す
Function IsMatch(target As String, conditions() As String) As Boolean
    Dim i As Long
    IsMatch = False ' 初期値
    
    ' LBound と UBound で配列の先頭から末尾までループ
    For i = LBound(conditions) To UBound(conditions)
        If Trim(conditions(i)) <> "" Then
            If InStr(1, target, Trim(conditions(i)), vbTextCompare) > 0 Then
                IsMatch = True
                Exit Function
            End If
        End If
    Next i
End Function

' 補助関数：文字列(target)が文字列のリスト(conditions)に対して１つでも一致していない項目があれば False を返す
Function IsAllMatch(target As String, conditions() As String) As Boolean
    Dim i As Long
    IsAllMatch = True
    
    For i = LBound(conditions) To UBound(conditions)
        If Trim(conditions(i)) <> "" Then
            ' もし一致しなければ False にして終了
            If InStr(1, target, Trim(conditions(i)), vbTextCompare) = 0 Then
                IsAllMatch = False
                Exit Function
            End If
        End If
    Next i
        
End Function

```
（記事を書いている今現在「こんなにコード長かったっけ？？？」と困惑中）

前半でフィルターをかけるための下準備をし、後半のFor文でフィルターの仕組みを作成している。

### 2：現数名の宣言とシート指定

```vb
Dim srcWS As Worksheet, destWS As Worksheet
Set srcWS = ThisWorkbook.Sheets("Sheet1")
Set destWS = ThisWorkbook.Sheets("Sheet2")
```
srcWS → 検索元
destWS → 結果表示先

### 3：検索条件の取得

```vb
genreList = SplitCondition(destWS.Range(genreListRng).Value)
subGenreList = SplitCondition(destWS.Range(subGenreListRng).Value)
keywordList = SplitCondition(destWS.Range(keywordListRng).Value)
```

SplitCondition関数で「、」区切りの文字列を配列に変換。SplitCondition関数の詳細は後述。
条件が空の場合も配列として扱えるようにしている。

### 4： 検索モード（AND／OR）のチェック

```vb
    searchMode = UCase(Trim(destWS.Range(searchModeRng).Value))

    If searchMode <> "AND" And searchMode <> "OR" Then
        MsgBox "検索モード（" & searchModeRng & "セル）は「AND」または「OR」で指定してください。", vbExclamation
        Exit Sub
    End If
```

UCase()で大文字に変換。
誤入力があれば警告を出して処理中断。

### 5：日付の設定と初期化
```vb
If IsDate(...) Then ...
```
開始日と終了日が入力されているかを確認。
片方しか入力がない場合は、もう片方を自動補完（例：未入力の終了日は当日）。

### 6：抽出対象の初期化と結果領域のクリア
```vb
destWS.Range("A" & destStartRow & ":Z10000").ClearContents
```
過去の検索結果を削除。

### 7：ループ処理
```vb
For i = srcStartRow To srcLastRow
```
Sheet1 のデータを 2行目から最終行までループ。
各行について以下を判定する。

#### 7-1：テキスト条件の一致判定
```vb
genreCond = IsAllMatch(...)
    or 
genreCond = IsMatch(...)
```
IsAllMatch → 配列すべてに一致（AND用）
IsMatch → 配列のいずれかに一致（OR用）
※各項目の検索条件は複数検索可能であり、ORは一つだけ一致で良いがANDはすべて一致の必要があるため分けている。

#### 7-2：日付条件の判定
```vb
dateCond = (currentDate >= startDate And currentDate <= endDate)
```
セルの日付が指定範囲に入っているか確認。

#### 7-3：条件を満たしているか（AND／OR判定）
```vb
If searchMode = "AND" Then
```
ANDの場合 → すべての条件を満たす必要がある。
ORの場合 → テキスト条件のいずれかと日付条件を満たすかを判定。全条件が空欄なら全件ヒット。

### 8：条件一致行の貼り付け
```vb
srcWS.Range("A" & i & ":D" & i).Copy destWS.Range("A" & destRow)
```
一致した行をSheet2にコピー。

### 9：件数出力
```vb
destWS.Range("F" & destStartRow - 1).Value = destRow - destStartRow
```
F3セルにヒット件数を表示

### 10：補助関数
<b>SplitCondition</b>
文字列を「、」または「，」で区切って配列に変換。
空欄なら空の配列を返す。

<b>IsAllMatch</b>
条件リスト内のすべての項目に一致していなければ False

<b>IsMatch</b>
指定された文字列が、条件リスト内のいずれかに部分一致していれば True

### まとめ
大雑把に解説したので、未来の自分が見たらさぞ怒り狂うであろう。
注意点としてソース用シートと出力用シートの各列は一致しなければいけない仕様になっている。
もしそれぞれ別の列に表示したいときは書き換える必要がある。