Private Sub cmdFIND_Click()
Sheets("Result").UsedRange.ClearContents
Application.ScreenUpdating = False
Dim s As String, v As Variant, r As Long, c As Long, arr() As Variant, cnt As Long, cnt1 As Long, cnt2 As Long, x As Long
Sheets("Result").UsedRange.ClearContents
Sheets("Data").Activate
v = Range("B1", Range("B" & Rows.Count).End(xlUp)).Resize(, 6).Value
s = Me.TextBox1.Value
If InStr(1, s, " ") > 0 Then
cnt = Application.CountIf(Range("E1", Range("E" & Rows.Count).End(xlUp)), "*" & s & "*")
ReDim arr(cnt, 6)
For r = LBound(v) To UBound(v)
If v(r, 4) Like "*" & s & "*" Then
For c = LBound(v, 2) To UBound(v, 2)
arr(x, c) = v(r, c)
Next c
x = x + 1
End If
Next r
Else
s = Me.TextBox1.Value
cnt1 = Application.CountIf(Range("E1", Range("E" & Rows.Count).End(xlUp)), "* " & s & " *")
cnt2 = Application.CountIf(Range("E1", Range("E" & Rows.Count).End(xlUp)), "* " & s & ".*")
cnt = cnt1 + cnt2
ReDim arr(cnt, 6)
For r = LBound(v) To UBound(v)
If InStr(1, " " & v(r, 4) & " ", " " & s & " ", vbTextCompare) > 0 Or InStr(1, " " & v(r, 4) & " ", " " & s & ".", vbTextCompare) Then
For c = LBound(v, 2) To UBound(v, 2)
arr(x, c) = v(r, c)
Next c
x = x + 1
End If
Next r
End If
Sheets("Result").Range("A1").Resize(cnt, 6).Value = arr
Unload Me
Application.ScreenUpdating = True
End Sub