コラム

日付を数値でも文字列でも検索する

2024.09.07

法律事務所における日付データの実態

エクセルのセルに日付を入力すると、基本的には自動的に日付データ（数値）で入力されます。このため、日付の表示形式を変更したり、並び替えたり、検索したりすることが簡単に行えます。

ただし、法律事務所でのエクセルの使い方では、他の文字列と一緒に日付が入力されていたり（例：「事故発生日：R6.9.7」）、1つのセルの中に2つ以上の日付が改行で区切って入力されていたりします。このため、日付の表示形式の変更、並び替えや検索が難しくなってしまっています。

特に検索は、法律事務所のデータを活用するうえで欠かせない機能です。しかし、上記のような状態で入力されているデータの中から日付を検索しようとすると、「数式（数値）」と「値（文字列）」の両方を検索しなければなりませんし、文字列（値）については、西暦と和暦の両方を検索しなければなりません。

日付を数値でも文字列でも検索できるマクロ

そこで日付を数値でも文字列でも検索できるマクロを作成してみました。

このサイトで紹介している「VA事件データベース」は、この検索機能を搭載しています。

法律事務所の事件とタスクをデータベースで管理（エクセルVBA)
事件に関する情報を共有したり、利益相反をチェックしたりするためには、「事件（案件）の管理」が欠かせません。クラウド型の事件管理システムを使ったり、データベースを構築したりしても良いのですが、費用や手間がかかるのが問題です。そこで、エクセルだけで簡単に管理する方法を紹介します。
vba-assets.net
2021.08.09

行ごとの検索

Sub ApplySearch(strTable, strArray, strParameter, lngKeys, lngTargets)
''処理時間を計測する
'Dim dblStart As Double
'dblStart = Timer

'エラー処理
On Error GoTo HandleErr

'検索文字列の全角空白を半角空白に入れ替える
strArray = Replace(strArray, "　", " ")

'検索文字列を分割して配列に入れる
'区切り文字を省略すると" "で分割される
Dim varArray As Variant
varArray = Split(strArray)
    
'テーブルの更新日時を配列に入れる
Dim varUpdate() As Variant
varUpdate = Range(strTable).Columns(Range(strTable).Columns.Count).Value
    
'エラー処理
On Error GoTo HandleErr2
    
'すべての行を繰り返す
Dim rngRow As Range
r = 0
For Each rngRow In Range(strTable).Rows
    '行番号を把握する
    r = r + 1
    
    '検索範囲を設定する
    Dim rngSearch As Range
    Set rngSearch = Range(Range(strTable)(r, lngKeys + 1), _
        Range(strTable)(r, lngKeys + lngTargets))
        
    '更新日時を把握する
    dblUpdate = varUpdate(r, 1)
    
    '更新日時を使用していない場合は1を代入する
    If dblUpdate = 0 Then dblUpdate = 1
                
    'すべての検索文字列を繰り返す
    Dim blnFound As Boolean
    Dim strSearch As String
    Dim lngSearch As Long
    Dim strSearchSeireki As String
    Dim strSearchWareki As String
    For i = 0 To UBound(varArray)
        '検索結果を未了にする
        blnFound = False
        
        '検索文字列を設定する
        strSearch = varArray(i)
        
        '日付型に変換可能な場合
        If IsDate(strSearch) = True Then
            'シリアル値に変換する
            lngSearch = Int(CDbl(CDate(strSearch)))
            
            '西暦形式に変換する
            strSearchSeireki = Format(DateValue(strSearch), "yyyy/m/d")
            
            '和暦形式に変換する
            strSearchWareki = Format(DateValue(strSearch), "ge.m.d")
        Else
            '値を消去する
            lngSearch = 0
            strSearchSeireki = ""
            strSearchWareki = ""
        End If
                    
        'パラメータがANDの場合
        If strParameter = "AND" Then
            '更新日時を正の値にする
            If dblUpdate < 0 Then varUpdate(r, 1) = Abs(dblUpdate)
                
            'すべてのセルを繰り返す
            Dim rngCell As Range
            For Each rngCell In rngSearch
                '値に検索文字列が存在する場合に検索結果を完了にする
                If rngCell.Value Like "*" & strSearch & "*" Then blnFound = True
                    
                '数式に日付型検索数値が一致する場合に検索結果を完了にする
                If lngSearch <> 0 Then
                    If rngCell.Value2 Like lngSearch Then blnFound = True
                End If
                       
                '値に検索文字列（西暦）が存在する場合に検索結果を完了にする
                If strSearchSeireki <> "" Then
                    If rngCell.Value Like "*" & strSearchSeireki & "*" Then blnFound = True
                End If
                
                '値に検索文字列（和暦）が存在する場合に検索結果を完了にする
                If strSearchWareki <> "" Then
                    If rngCell.Value Like "*" & strSearchWareki & "*" Then blnFound = True
                End If
            Next
                
            '検索結果が未了の場合
            If blnFound = False Then
                '更新日時を負の値にする
                varUpdate(r, 1) = Abs(dblUpdate) * (-1)
            End If
        'パラメータがORの場合
        Else
            '更新日時を負の値に変更する
            If dblUpdate > 0 Then varUpdate(r, 1) = Abs(dblUpdate) * (-1)
            
            For Each rngCell In rngSearch
                '値に検索文字列が存在する場合に更新日時を正の値にする
                If rngCell.Value Like "*" & strSearch & "*" Then varUpdate(r, 1) = Abs(dblUpdate)
                    
                '数式に日付型検索数値が一致する場合に更新日時を正の値にする
                If lngSearch <> 0 Then
                    If rngCell.Value2 Like lngSearch Then varUpdate(r, 1) = Abs(dblUpdate)
                End If
                       
                '値に検索文字列（西暦）が存在する場合に更新日時を正の値にする
                If strSearchSeireki <> "" Then
                    If rngCell.Value Like "*" & strSearchSeireki & "*" Then varUpdate(r, 1) = Abs(dblUpdate)
                End If
                
                '値に検索文字列（和暦）が存在する場合に更新日時を正の値にする
                If strSearchWareki <> "" Then
                    If rngCell.Value Like "*" & strSearchWareki & "*" Then varUpdate(r, 1) = Abs(dblUpdate)
                End If
            Next
        End If
    Next
Next

'更新日時配列をテーブルに書き込む
Range(strTable).Columns(Range(strTable).Columns.Count).Value = varUpdate
    
''処理時間を計測する
'Dim dblEnd As Double
'dblEnd = Timer
'MsgBox dblEnd - dblStart
Exit Sub

HandleErr2:
MsgBox "エラーが発生しました。" & vbCr & "検索文字列に不適切な文字列が含まれている可能性があります。", vbExclamation

HandleErr:
End Sub

Sub CancelSearch(strTable)

'エラー処理を設定する
On Error GoTo HandleErr

'テーブルの更新日時を配列に入れる
Dim varUpdate() As Variant
varUpdate = Range(strTable).Columns(Range(strTable).Columns.Count).Value

'すべての行を繰り返す
For r = 1 To Range(strTable).Rows.Count
    '更新日時を絶対値に変更する
    Dim dblUpdate As Double
    dblUpdate = varUpdate(r, 1)
    varUpdate(r, 1) = Abs(dblUpdate)
Next

'更新日時配列をテーブルに書き込む
Range(strTable).Columns(Range(strTable).Columns.Count).Value = varUpdate

HandleErr:
End Sub

行ごとに次の4つの検索を行い、その結果をAND（論理積）またはOR（論理和）のいずれかで処理を行うようにしています。

  • 値（Value）に検索文字列が含まれているか
  • 数式（Value2）に日付型検索数値が一致するか
  • 値（Value）に検索文字列（西暦）が含まれているか
  • 値（Value）に検索文字列（和暦）が含まれているか

検索には、Like関数を使っています。Findよりも処理が速いようです。

Findメソッド,Like演算子を使った検索:Excel VBA入門
www.eurus.dti.ne.jp

検索結果の表示

各行ごとの検索結果は、各行の「更新日時」の値の正負を切り替えることで記録しています。あとは、シートのフィルターを操作することで検索結果を表示できます。

Sub SearchData(strCommand As String, Optional strText As String, Optional strOption As String)

If strCommand = "Search" Then
    'シートのプロテクトを解除する
    Me.Unprotect
    
    Evnt.Disable
    '事件テーブルを選択する
    'テーブルを選択しておかないとフィルターを解除できません。
    Range("事件").Select
    
    'フィルターを解除する
    'テーブルのフィルターでは解除できません。
    If sht11.FilterMode = True Then
        On Error Resume Next
        sht11.ShowAllData
        On Error GoTo 0
    End If
    
    '検索結果を設定する
    Dim strSearch As String
    Call Srch.ApplySearch("事件", strText, strOption, 1, 32)
    
    'フィルターを設定する
    Range("事件").AutoFilter _
        field:=Range("事件").Columns.Count, _
        Criteria1:=">0"
        
    Evnt.Enable
    
    'シートのプロテクトを設定する
    If shtOpt.Range("事件モード") = "入力" Then _
        Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
        
    '最初の行までスクロールする
    'https://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_040.html
    Application.Goto Range("A1"), True
    
    '検索結果がなかった場合はメッセージを表示する
    'https://daitaideit.com/vba-autofilter-no-results/
    If WorksheetFunction.Subtotal(3, Range("事件[事件番号]")) = 0 Then
        MsgBox "該当するデータはありませんでした。"
    End If
Else
    'シートのプロテクトを解除する
    Me.Unprotect
    
    '現在の選択セルを把握
    Dim rngSelect As Range
    Set rngSelect = Selection
    
    '事件テーブルを選択する
    'テーブルを選択しておかないとフィルターを解除できません。
    Range("事件").Select
    
    'フィルターを解除する
    'テーブルのフィルターでは解除できません。
    If sht11.FilterMode = True Then
        On Error Resume Next
        sht11.ShowAllData
        On Error GoTo 0
    End If
    
    '検索結果を解除する
    Evnt.Disable
    Call Srch.CancelSearch("事件")
    Evnt.Enable
    
    'シートのプロテクトを設定する
    If shtOpt.Range("事件モード") = "入力" Then _
        Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
    
    '最初の選択セルを選択
    rngSelect.Select
End If
End Sub

検索条件に合致した行のみをフィルターで絞り込むという発想は、こちらの記事からヒントをいただきました。

Excel VBAで作る「表やテーブルからデータを検索・表示するツール」｜digitawa
どうもこんにちは、デジたわです。 管理表やノウハウを蓄積して表でまとめたデータのかたまりからある文字を検索して見やすく表示出来たらなと思ったことはないでしょうか。 通常は、Excel内で「ホーム」→「検索と選択」→「検索」から検索ダイアログ...
note.com

コメント

タイトルとURLをコピーしました