【マクロ・VBA】データベースサーチ

Sub データベースサーチ()

Dim Lastrow1  As Long, LastCol1 As Long
Dim sStr As String
Dim dataDB As Variant

'DB(検索するシート)を指定する
With ActiveSheet.Next
 Lastrow1 = .Cells(.Rows.Count, 1).End(xlUp).Row
 LastCol1 = .Cells(1, Columns.Count).End(xlToLeft).Column
 dataDB = .Range(.Cells(1, 1), .Cells(Lastrow1, LastCol1)).Value
End With

'抽出するシートを指定する
With Worksheets("検索")
sStr = .Range("A2").Value

'検索結果削除
Lastrow1 = .Cells(.Rows.Count, 1).End(xlUp).Row
If Lastrow1 >= 4 Then
.Range(.Rows(4), Rows(Lastrow1)).Delete
End If

'項目取得
With .Range(.Cells(4, 1), Cells(4, UBound(dataDB, 2)))
.Value = dataDB
.Interior.Color = RGB(255, 255, 0)
End With

'検索結果
Lastrow1 = 4
For i = 2 To UBound(dataDB, 1)
    Dim memo As String: memo = ""
    For j = 1 To UBound(dataDB, 2)
        memo = memo & dataDB(i, j)
    Next j
    
    If memo Like "*" & sStr & "*" Then
        Lastrow1 = Lastrow1 + 1
    
        For j = 1 To UBound(dataDB, 2)
        .Cells(Lastrow1, j) = dataDB(i, j)
        Next j
    End If
Next i

'表の枠組み
.Range(.Cells(4, 1), Cells(Lastrow1, UBound(dataDB, 2))) _
.Borders.LineStyle = xlcontinous

End With

MsgBox "完了"
End Sub