VBAで日付セルの検索を行う｜ Excel作業をVBAで効率化

日付セルの種類

日付セルの検索を行う場合、重要なのは日付がどのように入力されているか、という点です。

Excelで日付を入力する場合、そのセルの書式によってシリアル値なのか文字列なのかに大別されます。

ユーザー定義の表示形式で「yyyy/mm/dd(aaa)」として「2018/07/05(木)」のような表示をしている場合もありますがこれはシリアル値と同じ考え方になります。

日付について言えば、セルでの見た目がなんであれ、表示形式が文字列でないものはシリアル値と考えて構いません。

シリアル値の日付

新規ブックに「2018/1/1」のように入力すれば、セルの表示形式は「標準」のためシリアル値として登録されます。

シリアル値とは日時を数値としてもっている値で、1900/1/1を1とする値です。1日ごとに1が加算され、時刻を小数で表します。

日付のシリアル値を確認したい場合は日付を入力したあとで、セルの書式設定ダイアログを表示し、セルの表示形式を「日付」から「標準」に変更するとサンプル欄に表示されます。

文字列の日付

見た目上は日付ですが、セルの値としてはただの文字列の場合があります。

それはセルの表示形式が「文字列」になっている場合です。

「”2018/7/5″」
「”2018/07/05″」

この２つの日付はどちらも人の目で見れば同じ日付ですが、文字列が異なるため、0がある日付を検索した場合と0が無い日付を検索した場合で結果が異なります。

シリアル値と文字列の両方の日付を一緒に検索させるには

例えば以下のような日付の種類があるシートで、2018/7/5の検索を行って全て検索に一致させるには工夫が必要です。

Findメソッドは一度に１つの検索条件しか設定できません。しかし日付はシリアル値と文字列とで検索値が異なります。

そこで、シリアル値の日付と文字列の日付をそれぞれ分けてFindメソッドを実行します。

具体的には検索したい日付のフォーマットを全て配列に格納します。以下のコードではDate型、yyyy/mm/dd文字列、yyyy/m/d文字列の３つにしています。

その配列の各要素を使ってFindメソッドを実行し、シートの全セルを検索します。

参照設定

以下のソースコードではDictionaryクラスを利用しています。

VBA画面のツールメニュー→参照設定でMicrosoft Scripting Runtimeにチェックを付けておく必要があります。

複数の日付フォーマットを検索する関数

以下のコードはアクティブシートからシリアル値のDate型の日付と、yyyy/mm/dd文字列、yyyy/m/d文字列の日付の３種類を検索します。

日付文字列のフォーマットを編集したい場合は配列arのサイズを4に拡張し、「ar(3) = Format(dt, ‘yyyy/mm’)」などを追加してください。

検索で見つかったセルはDictionaryオブジェクトに追加しています。

Sub FindDate(dt As Date, dic As Dictionary)
    Dim r       As Range            '// 検索セル
    Dim ar()    As Variant          '// 日付フォーマット配列
    Dim i       As Integer          '// 配列インデックス
    
    Set dic = New Dictionary
    
    '// 基点をアクティブセルとする
    Set r = ActiveCell
    
    '// シリアル値と文字列を配列に格納
    ReDim ar(2)
    ar(0) = dt                          '// Date型日付
    ar(1) = Format(dt, "yyyy/mm/dd")    '// yyyy/mm/dd形式日付
    ar(2) = Format(dt, "yyyy/m/d")      '// yyyy/m/d形式日付
    
    i = 0
    
    Do
        '// セルを検索
        Set r = Cells.Find( _
            What:=ar(i), _
            After:=r, _
            LookIn:=xlFormulas, _
            LookAt:=xlPart, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=False, _
            MatchByte:=False, _
            SearchFormat:=False)
        
        '// セルが検索された場合
        If Not r Is Nothing Then
            '// 既に検索済みのセルの場合（最初の検索開始位置を再検索した場合）
            If (dic.Exists(r.Address) = True) Then
                '// 配列末端に未達の場合
                If (i < UBound(ar)) Then
                    '// 次の日付配列を検索するために加算
                    i = i + 1
                Else
                    '// 配列の全ての日付を検索したため終了
                    Exit Do
                End If
            '// 初めて検索したセルの場合
            Else
                '// 検索したセルを保持
                Call dic.Add(r.Address, r)
                
                '// 検索で見つかったセルを選択
                r.Select
            End If
        '// セルが検索されなかった場合
        Else
            '// 配列末端に未達の場合
            If (i < UBound(ar)) Then
                '// 次の日付配列を検索するために加算
                i = i + 1
            Else
                '// 配列の全ての日付を検索したため終了
                Exit Do
            End If
            
            Set r = ActiveCell
        End If
    Loop
End Sub

Sub FindDate(dt As Date, dic As Dictionary)

Dim r As Range '// 検索セル

Dim ar() As Variant '// 日付フォーマット配列

Dim i As Integer '// 配列インデックス

Set dic = New Dictionary

'// 基点をアクティブセルとする

Set r = ActiveCell

'// シリアル値と文字列を配列に格納

ReDim ar(2)

ar(0) = dt '// Date型日付

ar(1) = Format(dt, "yyyy/mm/dd") '// yyyy/mm/dd形式日付

ar(2) = Format(dt, "yyyy/m/d") '// yyyy/m/d形式日付

i = 0

'// セルを検索

Set r = Cells.Find( _

What:=ar(i), _

After:=r, _

LookIn:=xlFormulas, _

LookAt:=xlPart, _

SearchOrder:=xlByRows, _

SearchDirection:=xlNext, _

MatchCase:=False, _

MatchByte:=False, _

SearchFormat:=False)

'// セルが検索された場合

If Not r Is Nothing Then

'// 既に検索済みのセルの場合（最初の検索開始位置を再検索した場合）

If (dic.Exists(r.Address) = True) Then

'// 配列末端に未達の場合

If (i < UBound(ar)) Then

'// 次の日付配列を検索するために加算

i = i + 1

Else

'// 配列の全ての日付を検索したため終了

Exit Do

End If

'// 初めて検索したセルの場合

Else

'// 検索したセルを保持

Call dic.Add(r.Address, r)

'// 検索で見つかったセルを選択

r.Select

End If

'// セルが検索されなかった場合

Else

'// 配列末端に未達の場合

If (i < UBound(ar)) Then

'// 次の日付配列を検索するために加算

i = i + 1

Else

'// 配列の全ての日付を検索したため終了

Exit Do

End If

Set r = ActiveCell

End If

Loop

End Sub

使い方

上のFindDate関数にDate型の日付と格納用のDictionaryオブジェクトを渡します。

あとはDictionaryのKeysプロパティでキーの配列を取得し、Dictionaryに格納されたRangeオブジェクトのアドレスと表示値を出力しています。

Sub FindDateTest()
    Dim dic As Dictionary
    Dim i
    Dim r   As Range
    Dim ar
    
    Call FindDate(CDate("2018/7/5"), dic)
    
    ar = dic.Keys
    
    For i = 0 To dic.Count - 1
        Set r = dic.Item(ar(i))
        Debug.Print r.Address & " : " & r.Text
    Next
End Sub

Sub FindDateTest()

Dim dic As Dictionary

Dim i

Dim r As Range

Dim ar

Call FindDate(CDate("2018/7/5"), dic)

ar = dic.Keys

For i = 0 To dic.Count - 1

Set r = dic.Item(ar(i))

Debug.Print r.Address & " : " & r.Text

End Sub

実行結果

実行するとイミディエイトウィンドウに以下が出力されます。

A7セルは文章で「2018/7/5です」とありますが、文字列のyyyy/m/dの検索条件に一致して検索されています。

$A$1 : 2018/7/5
$A$4 : 2018/7/5
$A$5 : 2018/07/05
$A$6 : 7月5日
$A$3 : 2018/07/05
$A$7 : 2018/7/5です
$A$2 : 2018/7/5

$A$1 : 2018/7/5

$A$4 : 2018/7/5

$A$5 : 2018/07/05

$A$6 : 7月5日

$A$3 : 2018/07/05

$A$7 : 2018/7/5です

$A$2 : 2018/7/5

日付セルの種類

シリアル値の日付

文字列の日付

シリアル値と文字列の両方の日付を一緒に検索させるには

参照設定

複数の日付フォーマットを検索する関数

使い方

実行結果

関連記事