特定キーワードを含むパスをフルパスリストから取得

Sub MatchKeywordsAndOutputPaths()
    ' 変数宣言
    Dim wsKeywords As Worksheet
    Dim wsPaths As Worksheet
    Dim lngLastRowKeywords As Long
    Dim lngLastRowPaths As Long
    Dim lngRowKeyword As Long
    Dim lngRowPath As Long
    Dim strKeyword As String
    Dim strPath As String

    ' ワークシートオブジェクトの設定
    Set wsKeywords = ThisWorkbook.Sheets("Sheet1")
    Set wsPaths = ThisWorkbook.Sheets("Sheet2")
    
    ' 各シートの最終行を取得
    lngLastRowKeywords = wsKeywords.Cells(wsKeywords.Rows.Count, "A").End(xlUp).Row
    lngLastRowPaths = wsPaths.Cells(wsPaths.Rows.Count, "A").End(xlUp).Row

    ' Sheet1のキーワードを1つずつ確認
    For lngRowKeyword = 1 To lngLastRowKeywords
        strKeyword = wsKeywords.Cells(lngRowKeyword, 1).Value
        
        ' Sheet2のパスを確認
        For lngRowPath = 1 To lngLastRowPaths
            strPath = wsPaths.Cells(lngRowPath, 1).Value
            
            ' キーワードがパスに含まれているかチェック
            If InStr(strPath, strKeyword) > 0 Then
                ' マッチしたらSheet1のB列にパスを出力
                wsKeywords.Cells(lngRowKeyword, 2).Value = strPath
                ' 1つ見つかれば次のキーワードへ
                Exit For
            End If
        Next lngRowPath
    Next lngRowKeyword
End Sub