[[20181205154637]] 『エクセルの検索機能』(しのみや) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『エクセルの検索機能』(しのみや)

 教えてください

    A
 1 日本の地図
 2 アメリカと世界
 3 インドとアメリカ 地図

 エクセルの検索機能で、
 「日本 地図」とスペースで区切って検索すると
 「日本」が入っているものと
 「地図」が入っているものと
 「日本」と「地図」どちらも入っているものを拾ってくる
 ようにしたい
 (上記のデータですと、A1とA3)

 調べていると * を使う方法があがってきましたが、
 これだと検索のときに「地図 日本」と指定すると 拾わなくなります

 ほかに方法はあるのでしょうか?

< 使用 Excel:Excel2010、使用 OS:Windows10 >


Sub main()
    Dim c As Range, r As Range, ip As String, i As Long
    ip = InputBox("検索ワードを入力(スペース区切可)")
    If ip = "" Then Exit Sub
    ip = Replace(ip, " ", " ")
    If WorksheetFunction.CountA(Cells) = 0 Then Exit Sub
    If InStr(ip, " ") > 0 Then
        For Each c In Cells.SpecialCells(2)
        For i = 0 To UBound(Split(ip, " "))
            If InStr(c.Value, Split(ip, " ")(i)) > 0 Then
                If r Is Nothing Then
                Set r = c
                Else
                Set r = Union(r, c)
                End If
            End If
        Next i
        Next c
        Else
        For Each c In Cells.SpecialCells(2)
            If InStr(c.Value, Split(ip, " ")(i)) > 0 Then
                If r Is Nothing Then
                Set r = c
                Else
                Set r = Union(r, c)
                End If
            End If
        Next c
    End If
    r.Select
    MsgBox "該当セルを選択しました。"
End Sub
(mm) 2018/12/05(水) 16:21

 mmさんありがとうございます

 さっそく確認させていただいたところ、
 指定したセルがきちんと選択されるようになりました

 ただ…結果を書いておかなくて申し訳ないのですが
 その行のみを表示させるようにしたいのです

 せっかく頂いたのにすみません

 頂いたマクロで作ってみようとしましたが、
 まったく違う作り方にしないといけないのかなと思って
 止まっております

 イメージとしては、インターネットの検索画面で
 検索をしてあがってくるような画面が出来ればと思っています

(しのみや) 2018/12/05(水) 16:51


Sub main()
    Dim c As Range, r As Range, ip As String, i As Long
    ip = InputBox("検索ワードを入力(スペース区切可)")
    If ip = "" Then Exit Sub
    ip = Replace(ip, " ", " ")
    If WorksheetFunction.CountA(Cells) = 0 Then Exit Sub
    If InStr(ip, " ") > 0 Then
        For Each c In Cells.SpecialCells(2)
        For i = 0 To UBound(Split(ip, " "))
            If InStr(c.Value, Split(ip, " ")(i)) > 0 Then
                If r Is Nothing Then
                Set r = c
                Else
                Set r = Union(r, c)
                End If
            End If
        Next i
        Next c
        Else
        For Each c In Cells.SpecialCells(2)
            If InStr(c.Value, Split(ip, " ")(i)) > 0 Then
                If r Is Nothing Then
                Set r = c
                Else
                Set r = Union(r, c)
                End If
            End If
        Next c
    End If
        Rows("1:" & Rows.Count).EntireRow.Hidden = True
        r.EntireRow.Hidden = False
End Sub
(mm) 2018/12/05(水) 17:03

 mmさんありがとうございます
 頂いた記述をもとに
 解読 & 対応をさせてもらっております

 考えていることは、Sheet2(シート名 検索画面)にテキストボックスとコマンドボタンを置き
 [     ] 検索

 検索ワードを入力して、検索ボタンを押すと
 Sheet1(シート名 Q&A)にある質問内容の行を表示させるようにしようと考えています

 ただいま解読に精一杯なのでシートを分ける対応は少し置いときます…

 今は、検索画面のシートにテキストボックスとコマンドボタンを置き
       A          B        C          D
 1 質問           回答
 2 サービスとは何ですか? AAAAAAAAAAAA
 3 利用するには?     BBBBBBBBBBBB
 4                      [     ] 検索 ←この辺りに置いています

 試しております

 最後の方の
  Rows("1:" & Rows.Count).EntireRow.Hidden = True
 で、「RangeクラスのHiddenプロパティを設定できません」のエラーで止まります

 Rows.Countは1048576です

 行の非表示のところとはわかるのですが、どういう対応をすればよいでしょうか?

 ****
 頂いた記述はわかりやすいように、文字にしていますが…
 わかりにくかったらすみません

 Private Sub Cmd検索_Click()

    Dim 質問 As Range, r As Range, i As Long
    Dim Str検索ワード As String

    Str検索ワード = Sheet2.Txt検索ワード.Text

    If Str検索ワード = "" Then Exit Sub

    Str検索ワード = Replace(Str検索ワード, " ", " ")

 '    If WorksheetFunction.CountA(Cells) = 0 Then Exit Sub

    '検索ワードが複数の場合
    If InStr(Str検索ワード, " ") > 0 Then

        For Each 質問 In Cells.SpecialCells(2)

            For i = 0 To UBound(Split(Str検索ワード, " "))

                If InStr(質問.Value, Split(Str検索ワード, " ")(i)) > 0 Then

                    If r Is Nothing Then
                        Set r = 質問
                    Else
                        Set r = Union(r, 質問)
                    End If

                End If

            Next i

        Next 質問

    '検索ワードがひとつの場合
    Else

        For Each 質問 In Cells.SpecialCells(2)

            If InStr(質問.Value, Split(Str検索ワード, " ")(i)) > 0 Then

                If r Is Nothing Then

                    Set r = 質問

                Else

                    Set r = Union(r, 質問)

                End If

            End If

        Next 質問

    End If

    Rows("1:" & Rows.Count).EntireRow.Hidden = True  ←ここでエラーになります
    r.EntireRow.Hidden = False

 End Sub
 ***
(しのみや) 2018/12/06(木) 15:00

 すみません
 検索画面のシートにテキストボックスとコマンドボタンを置いているからですね
 失礼しました
(しのみや) 2018/12/06(木) 15:13

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.