【VBA】入力フォームを使った、フィルタについて

Excel VBAでユーザフォームのテキストボックスから取得したデータで、フィルタをかけることについて教えていただけないでしょうか。

下記のようなデータから、フォームに入力された文字列と部分一致するものを抽出したいと思っています。

　　A　　　B　　　　C
1　aaa　　555　　××株式会社
2　bbb　　333　　株式会社△△
3　ccc　　123　　□□センター
　　　　　　　　・
　　　　　　　　・
　　　　　　　　・
　　　　　　　　・

テキストボックスには複数のデータを入力するので、改行ごとに配列にして
1行ずつ探す、というところまではできたのですが
完全一致でしか検索することができません。

C列で探すときに、”株式会社”とフォームに入力すると、
1行目と2行目が抽出されるといったような形にしたいです。

ワイルドカードのようなものを使用して、
あいまい検索といいますか、配列にしたデータから部分一致で抽出をすることはできないのでしょうか？

現在、完全一致で抽出まではできたコードはこのような形です。

-------------------------
Private Sub CommandButton1_Click()

' 入力欄内のテキストを配列にして1行ずつ取得
Dim ArrayText
ArrayText = Split(入力欄.Text, vbCrLf)

' 入力欄空欄はエラー
If 入力欄 = "" Then
MsgBox "検索条件を入力してください。", vbExclamation, "入力エラー"
Exit Sub
End If

ActiveSheet.Range("A1:W1").AutoFilter field:=3, Criteria1:=ArrayText, _
Operator:=xlFilterValues


' 入力欄のクリア
入力欄 = ""

End Sub


-------------------------

いろいろ検索はしてみたのですが、アクセスばかりがヒットしてしまい…
VBAで実現するのは不可能なのでしょうか・・・？
まだまだ、VBA勉強しはじめなので根本的に違う部分等あるかもしれませんが、
どなたかご教授いただけないでしょうか。

宜しくお願い致します。

No.1 回答者： WindFaller 回答日時： 2017/01/24 20:56

こんばんは。

Criteria1:=ArrayText,
ArrayText は、そこに配列を入れて複数検索が可能ではあるのですが、ワイルドカードが使えたかどうか、あまりはっきりと記憶にありません。それ以外では、Operator:= xlOr で2個は可能ですが、それ以上はできないような気がします。それで、その代わりとしては、AdvancedFilter を使ってみました。
クライテリアは、Z1 に設けましたが、できるだけ、1行目から書く方法がよかったと思います。

それから、 .Range("A1:W1").CurrentRegion　という部分は、多少問題が残るかと思います。きちんと、データと分かれていればよいのですが、そうでないと、別な所まで及んでしまいます。

細かい部分で抜けている所があるかもしれません。

'//
Private Sub CommandButton1_Click()
　Dim i As Long, j As Long
　Dim ArrayText
　Dim ArrayText2
　Dim CrRng As Range
　With ActiveSheet
　'クライテリアを消去
　.Range("Z1").CurrentRegion.Columns(1).ClearContents
　ArrayText = Split(入力欄.Text, vbCrLf)
　
　'入力欄に何もない状態で、クリックすると、全体が現れる
　If UBound(ArrayText) < 0 Then
　　If .FilterMode Then
　　　.ShowAllData
　　End If
　　Exit Sub
　End If
　'貼り付けようの配列
　ReDim ArrayText2(UBound(ArrayText), 0)
　
　For i = 0 To UBound(ArrayText)
　　If ArrayText(i) <> "" Then
　　　ArrayText2(j, 0) = "*" & ArrayText(i) & "*"
　　　j = j + 1
　　End If
　Next i
　If j < 1 Then Exit Sub　'ArrayText2 の移行に失敗したら終了
　　'クライテリアをここで作る
　　.Range("Z1").Value = .Range("C1").Value
　　.Range("Z1").Offset(1).Resize(i + 1).Value = ArrayText2
　　Set CrRng = .Range("Z1").CurrentRegion.Resize(, 1)
　　'フィルターオプションで実行
　　 .Range("A1:W1").CurrentRegion.AdvancedFilter _
　　　　 Action:=xlFilterInPlace, _
　　　　 CriteriaRange:=CrRng, _
　　　　 Unique:=False
　End With
　　'入力欄のクリア
　　入力欄.Text = ""
End Sub