LoginSignup
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

@ShineYamamoto(M Yamamoto)

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

Last updated at Posted at 2025-05-18

はじめに

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

今回の要点

  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：全体像

まずは全体のプログラムから。

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：現数名の宣言とシート指定

Dim srcWS As Worksheet, destWS As Worksheet
Set srcWS = ThisWorkbook.Sheets("Sheet1")
Set destWS = ThisWorkbook.Sheets("Sheet2")

srcWS → 検索元
destWS → 結果表示先

3：検索条件の取得

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

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

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

    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：日付の設定と初期化

If IsDate(...) Then ...

開始日と終了日が入力されているかを確認。
片方しか入力がない場合は、もう片方を自動補完（例：未入力の終了日は当日）。

6：抽出対象の初期化と結果領域のクリア

destWS.Range("A" & destStartRow & ":Z10000").ClearContents

過去の検索結果を削除。

7：ループ処理

For i = srcStartRow To srcLastRow

Sheet1 のデータを 2行目から最終行までループ。
各行について以下を判定する。

7-1：テキスト条件の一致判定

genreCond = IsAllMatch(...)
    or 
genreCond = IsMatch(...)

IsAllMatch → 配列すべてに一致（AND用）
IsMatch → 配列のいずれかに一致（OR用）
※各項目の検索条件は複数検索可能であり、ORは一つだけ一致で良いがANDはすべて一致の必要があるため分けている。

7-2：日付条件の判定

dateCond = (currentDate >= startDate And currentDate <= endDate)

セルの日付が指定範囲に入っているか確認。

7-3：条件を満たしているか（AND／OR判定）

If searchMode = "AND" Then

ANDの場合 → すべての条件を満たす必要がある。
ORの場合 → テキスト条件のいずれかと日付条件を満たすかを判定。全条件が空欄なら全件ヒット。

8：条件一致行の貼り付け

srcWS.Range("A" & i & ":D" & i).Copy destWS.Range("A" & destRow)

一致した行をSheet2にコピー。

9：件数出力

destWS.Range("F" & destStartRow - 1).Value = destRow - destStartRow

F3セルにヒット件数を表示

10：補助関数

SplitCondition
文字列を「、」または「，」で区切って配列に変換。
空欄なら空の配列を返す。

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

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

まとめ

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

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?