VBA 文字検索　セルに入力した文字を含むセル行だけを表示したい(ｵｰﾄﾌｨﾙﾀのように)

###実現したいこと
セルに入力した文字を含むセルがあった場合
①該当するセルの背景色を変えたい
②当てはまるセルがあった場合
→その検索文字を含む行だけを表示したい(ｵｰﾄﾌｨﾙﾀのように)
出来なければ、該当するセルにジャンプするようにしたい。(複数あれば、エンターキーでジャンプしたい)

##画面イメージ

すべてD列に記載されてあります。

例
文字検索 D3「スイ」

アジサイ
ﾁｭｰﾘｯﾌﾟ
すみれ
ｱﾈﾓﾈ
ｶｻﾌﾞﾗﾝｶ
ﾎｳｾﾝｶ
ｽｲｾﾝ
ハイビスカス
ﾊﾅﾌﾞｼｮｳ
ﾌﾞｰｹﾞﾝﾋﾞﾘｱ
ﾌﾘｰｼﾞｱ
ベゴニア
ﾏﾘｰｺﾞｰﾙﾄﾞ
ルピナス
ﾗﾝﾀﾅ
ラン
ラベンダー
ユキヤナギ
ﾓｸﾚﾝ

###該当のソースコード

Private Sub Worksheet_Change(ByVal Target As Range)
  
 Dim Rng As Range
 Dim Hit As Long
 Dim Cnt As Long
 Dim Row As Long
 Dim Row1 As Long
 Dim strValue    As String
 Dim Row_END As Long
 
    If Target.Address = "$D$3" Then   '文字が変更されたら
        Row_END = Cells(Rows.Count, "D").End(xlUp).Row          '最終行
        Range("D6:D" & Row_END).Interior.ColorIndex = xlNone    '初期化
        strValue = "*" & Range("D3").Value & "*"
        Hit = 0
        
        For Row = 6 To Row_END
            If Range("D" & Row).Value Like strValue Then
                Hit = 1
                Range("D" & Row).Interior.ColorIndex = 40
                Row1 = Row + 1
            End If
        Next

        If Hit = 0 Then
                MsgBox "該当する花名がないですよ☆"
        End If
    End If

End Sub

###補足
VBAは、初心者で、勉強中です！
わからないところばかりなのですが、、、どうぞよろしくお願い致します。

haruto4649

2017/01/06 01:20

広告ではありません。

Y.H.

2017/01/06 01:27

２つも同じ質問をするのはなぜ？ https://teratail.com/questions/61019 操作ミスなどの場合は不要な方を削除申請してください。

haruto4649

2017/01/06 01:44

Y.H.様　大変失礼いたしました。削除申請をいたしました。教えて頂きありがとうございました。

行動規範の内容に同意します

回答1件

ベストアンサー

こんな感じで組んでみました。ポイントはHiddenプロパティを設定しているところで、該当がなければ当該行をhidden(非表示)にすることでフィルターっぽくしてます。

VBA
1Private Sub Worksheet_Change(ByVal Target As Range)
2
3 Dim Rng As Range
4 Dim Hit As Long
5 Dim Cnt As Long
6 Dim Row As Long
7 Dim Row1 As Long
8 Dim strValue    As String
9 Dim Row_END As Long
10
11    If Target.Address = "$D$3" Then   '文字が変更されたら
12        Rows("6:" & Rows.Count).Hidden = False     '非表示状態の初期化
13        Row_END = Cells(Rows.Count, "D").End(xlUp).Row          '最終行
14        Range("D6:D" & Row_END).Interior.ColorIndex = xlNone    '初期化
15
16        strValue = "*" & Range("D3").Value & "*"
17        Hit = 0
18
19        For Row = 6 To Row_END
20            If Range("D" & Row).Value Like strValue Then
21                Hit = 1
22                Range("D" & Row).Interior.ColorIndex = 40
23                Row1 = Row + 1
24            Else
25                Rows(Row).Hidden = True
26            End If
27        Next
28
29        If Hit = 0 Then
30                MsgBox "該当する花名がないですよ☆"
31                Rows("6:" & Rows.Count).Hidden = False     '非表示状態の初期化
32        End If
33    End If
34
35End Sub
36