Step7　10個の文字列を全ファイル内から検索する

含む／含まないを検索するようにしていましたが、分ける必要がないようなので、検索し見つかった個数を赤色・太字で表示するようにします。見つからなければ、0と薄い文字で表示されます。

シートの修正

「含まない」を移動し、検索文字列を10個にしました。


ここも、「含まない」をなくし検索文字列に変更しました。

VBAコードの変更

MyFileSerachを下記のように変更しました。

For i=0 to 9で10個の文字列を繰り返し検索しています。

見つかれば赤色・太字にしています。
Cells(lr, i + 10).Font.Color = RGB(255, 0, 0)
Cells(lr, i + 10).Font.Bold = True

Private Sub MyFileSerach(lr As Long, lc As Long)
    Dim fname As String
    Dim fn As Long
    Dim buf As String
    Dim lpos As Long
    Dim smoji As String
    Dim n As Long
    Dim lcoun As Long
    Dim lmlc As Long
    Dim i As Long
    
    fname = Cells(lr, lc) & Cells(lr, lc + 1)
    
    fn = FreeFile
    buf = Space(FileLen(fname))
    Open fname For Binary As #fn
        Get #fn, , buf
    Close #fn
    
    For i = 0 To 9
        smoji = Cells(2, i + 10)
        If smoji <> "" Then
            lcoun = 0
            lpos = 1
            Do
                n = InStr(lpos, buf, smoji)
                If n > 0 Then
                    lcoun = lcoun + 1
                    lpos = n + 1
                Else
                    Exit Do
            End If
            Loop
            If lcoun > 0 Then
                Cells(lr, i + 10).Font.Color = RGB(255, 0, 0)
                Cells(lr, i + 10).Font.Bold = True
            Else
                Cells(lr, i + 10).Font.Color = RGB(128, 128, 128)
                Cells(lr, i + 10).Font.Bold = False
            End If
            Cells(lr, i + 10) = lcoun
        End If
    Next
End Sub

検索結果のシートです。