[[20200128075112]] 『検索で全角半角を区別しない。』(七草) ページの最後に飛ぶ

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

 

『検索で全角半角を区別しない。』(七草)

お世話になります。
現在しようしている、ワード検索で最近気が付いたのですが
文字の全角半角を区別しているみたいだというのがわかりました。
(あまり気にしていなかったです)
そこで、ネットで検索してソースを書き直してみました。
ですが、どうしてもひっかかるところがあります。
それが、どうしてもわかりません。
1週間ほど、いろいろやってみましたがうまくいきません。
諸先生方のお力をお借りしたいのですが・・・・

ソース

Private Sub CommandButton21_Click()

If Range("B4").Value = "" Then

    MsgBox "文字列を入力してください(あいまい検索)。"
    Exit Sub

  Else

    Dim kws As Worksheet
    Dim c As Range

    Set kws = Worksheets("文字列検索")

    If OptionButton1.Value = True Then

      Worksheets("1996年-2013年").Range("B2").AutoFilter Field:=2, Criteria1:="*" & Worksheets("文字列検索").Range("B4").Value & "*" _
      , Operator:=xlAnd, Criteria2:="*" & Worksheets("文字列検索").Range("B8").Value & "*"
      Worksheets("1996年-2013年").Select

      Worksheets("2014年-").Range("B2").AutoFilter Field:=2, Criteria1:="*" & Worksheets("文字列検索").Range("B4").Value & "*" _
      , Operator:=xlAnd, Criteria2:="*" & Worksheets("文字列検索").Range("B8").Value & "*"
      Worksheets("2014年-").Select

    For Each c In ActiveSheet.UsedRange
       これがだめです→ If StrConv(UCase(c.Value), vbNarrow) = StrConv(UCase(kws), vbNarrow) Then
            Debug.Print kws & " が存在します(" & c.Address & ")"
        End If
    Next c

 End If

    If OptionButton2.Value = True Then

      Worksheets("1996年-2013年").Range("B2").AutoFilter Field:=2, Criteria1:="*" & Worksheets("文字列検索").Range("B4").Value & "*" _
      , Operator:=xlOr, Criteria2:="*" & Worksheets("文字列検索").Range("B8").Value & "*"
      Worksheets("1996年-2013年").Select

      Worksheets("2014年-").Range("B2").AutoFilter Field:=2, Criteria1:="*" & Worksheets("文字列検索").Range("B4").Value & "*" _
      , Operator:=xlOr, Criteria2:="*" & Worksheets("文字列検索").Range("B8").Value & "*"
      Worksheets("2014年-").Select

    For Each c In ActiveSheet.UsedRange
        これがだめです→If StrConv(UCase(c.Value), vbNarrow) = StrConv(UCase(kws), vbNarrow) Then
            Debug.Print kws & " が存在します(" & c.Address & ")"
        End If
    Next c

      End If

  End If

End Sub

です。宜しく、お願い致します。

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


スマホなので、しっかりと読み込めてないですが、【部分一致】で"検索"したいのですよね?
だとすると、比較演算子は【=】ではなく【Like】ではないでしょうか?
 If StrConv(UCase(c.Value), vbNarrow) Like "*" & StrConv(UCase(kws), vbNarrow) & "*"
Then

また、普通は検索するならfindメソッドを使うとおもいます。
http://officetanaka.net/excel/vba/cell/cell11.htm

(もこな2) 2020/01/28(火) 08:47


失礼。↑の前半は忘れてください。
 Dim kws As Worksheet
 Set kws = Worksheets("文字列検索")
 〜StrConv(UCase(kws), vbNarrow) 

なにかおかしくないでしょうか?

(もこな2) 2020/01/28(火) 08:55


 >これがだめです→ If StrConv(UCase(c.Value), vbNarrow) = StrConv(UCase(kws), vbNarrow) Then
                                                                         ~↑~
        kwsって、ワークシートですよ。文字でもないものをどうやって大文字にするんですか?

(半平太) 2020/01/28(火) 09:11


やりたかったことを想像して整理してみるとこんな感じでしょうか?
    Sub 実験01()
        Dim 検索値1 As String
        Dim 検索値2 As String

        Stop ' ←ブレークポイントの代わり

        With Worksheets("文字列検索")
            検索値1 = .Range("B4").Value
            検索値2 = .Range("B8").Value
        End With

        If 検索値1 = "" Then
            MsgBox "文字列を入力してください(部分一致抽出)。"
            Exit Sub
        End If

        With Worksheets("1996年-2013年")
            .Range("B2").AutoFilter Field:=2, _
                Criteria1:="*" & 検索値1 & "*", Operator:=xlAnd, _
                Criteria2:="*" & 検索値2 & "*"
            .Select
        End With

        With Worksheets("2014年-")
            .Range("B2").AutoFilter Field:=2, _
                Criteria1:="*" & 検索値1 & "*", Operator:=xlAnd, _
                Criteria2:="*" & 検索値2 & "*"
            .Select

            With .AutoFilter.Range
                If WorksheetFunction.Subtotal(3, .Columns(2)) > 1 Then
                    MsgBox .Parent.Name & "シートに「" & 検索値1 & "」と「" & 検索値2 & "」を含むものが存在します"
                Else
                    MsgBox .Parent.Name & "シートに「" & 検索値1 & "」と「" & 検索値2 & "」を含むものは存在しません"
                End If
            End With
        End With

    End Sub

参考
http://officetanaka.net/excel/vba/tips/tips155b.htm

試してみれば分かると思いますが、オートフィルタは大文字と小文字を区別しませんし、そもそも"検索"ではなく"抽出"です。
なので、提示されたコードは【検索】もしていないし【大文字と小文字が区別されて困る】といった状況ではなく、Worksheet型で宣言した変数をString型のように扱ったために、【実行時エラー438 オブジェクトは、このプロパティまたはメソッドをサポートしてません。】が発生しているだけだと思われます。

ちなみに、Findメソッドで複数のキーワードを部分一致で"検索"するには

 (1) Findメソッドで対象シート(セル範囲)の全セルから検索値1を検索する
 (2)(1)がヒットしなかったら、一致無しと表示して終了
 (3)(1)がヒットしたら、FindNextメソッドで、引き続き検索値1を検索して、見つかったすべてのセルを覚えておく
 (4)Findメソッドで、(3)で覚えておいたセルの中から検索値2を検索する
 (5)(4)がヒットしなかったら、一致無しと表示して終了
 (6)(4)がヒットしたら、FindNextメソッドで、引き続き検索値2を検索して、見つかったすべてのセルを覚えておく
 (7)(6)で覚えていたセルのアドレスを表示する

というプロセスになるとおもいます。
なおFindメソッドであれば、「完全/部分一致」、「大文字小文字を区別 する/しない」は設計の段階で選ぶことができます。
(というか、選ばないと前回の設定が引き継がれるので、設定を推奨。)

(もこな2) 2020/01/28(火) 11:22


Option Explicit

Private Sub CommandButton21_Click()

    If Range("B4").Value = "" Then
        MsgBox "文字列を入力してください(あいまい検索)。"
        Exit Sub
    End If

    Dim kws As Worksheet
    Dim c As Range
    Dim flgAndOr As Long
    Dim sKeyWord1 As String
    Dim skeyword2 As String
    Dim rngFind1 As Range
    Dim rngFind2 As Range

    Set kws = Worksheets("文字列検索")
    sKeyWord1 = "*" & StrConv(UCase(kws.Range("B4").Value), vbNarrow) & "*"
    sKeyWord1 = "*" & StrConv(UCase(kws.Range("B8").Value), vbNarrow) & "*"
    If Me.OptionButton1.Value = True Then
        flgAndOr = xlAnd
    Else
        flgAndOr = xlOr
    End If

    With Worksheets("1996年-2013年").Range("B2").CurrentRegion
        .AutoFilter Field:=2, _
                    Criteria1:=sKeyWord1, _
                    Operator:=flgAndOr, _
                    Criteria2:=skeyword2
        If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
            Set rngFind1 = Intersect(.Offset(1), .Columns(2).SpecialCells(xlCellTypeVisible))
        End If
    End With

    With Worksheets("2014年-").Range("B2").CurrentRegion
        .AutoFilter Field:=2, _
                    Criteria1:=sKeyWord1, _
                    Operator:=flgAndOr, _
                    Criteria2:=skeyword2

        If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
            Set rngFind2 = Intersect(.Offset(1), .Columns(2).SpecialCells(xlCellTypeVisible))
        End If
    End With

    On Error Resume Next
    Debug.Print rngFind1.Address(False, False, , True)
    Debug.Print rngFind2.Address(False, False, , True)
    On Error GoTo 0
End Sub

半角全角を無視して検索するなら、
シート上の表に半角に統一した値を数式で追加するよう、
コードに書き加えてください。
現状のロジックだと、オートフィルターを掛けている意味がないです。
あと、変数の使い方ももう少し考えた方がいいと思います。
(※動作確認してません。あくまで作業の流れのイメージを参考までに書いただけです。)
(まっつわん) 2020/01/28(火) 12:29


反応ないですが追加で。

■1
目的が、該当するセルがあるかどうかだけ知りたいのであれば、まっつわんさんがコメントされているとおり、オートフィルタは何の関係もありません。
さらに言うと、無頓着に「ActiveSheet.UsedRange」を対象にしてますから、「Worksheets("2014年-").Select」されたあとのActiveSheetしか対象になってなかったりします。

なので、有無だけでよければ↓で目的達成です。
(CountIfs関数で、1個以上見つかれば有と判定できる)

        Sub 実験02()
        Dim 検索値1 As String
        Dim 検索値2 As String

        Stop ' ←ブレークポイントの代わり

        With Worksheets("文字列検索")
            検索値1 = .Range("B4").Value
            検索値2 = .Range("B8").Value
        End With

        If 検索値1 = "" Then
            MsgBox "文字列を入力してください(部分一致)。"
            Exit Sub
        End If

        With Worksheets("2014年-")
            If Application.CountIfs(.Columns("B"), "*" & 検索値1 & "*", .Columns("B"), "*" & 検索値2 & "*") Then
                MsgBox "【" & .Name & "】に「" & 検索値1 & "」と「" & 検索値2 & "」を含むものが存在します"
            Else
                MsgBox "【" & .Name & "】に「" & 検索値1 & "」と「" & 検索値2 & "」を含むものは存在しません"
            End If
        End With

    End Sub

■2
ただ、セル番地を表示しようと思うと↓のように"検索"が必要になります。

    Sub 実験03()
        Dim 検索値1 As String
        Dim 検索値2 As String
        Dim MyRNG As Range

        Stop ' ←ブレークポイントの代わり

        With Worksheets("文字列検索")
            検索値1 = .Range("B4").Value
            検索値2 = .Range("B8").Value
        End With

        If 検索値1 = "" Then
            MsgBox "文字列を入力してください(部分一致)。"
            Exit Sub
        End If

        With Worksheets("2014年-")
            If Application.CountIfs(.Columns("B"), "*" & 検索値1 & "*", .Columns("B"), "*" & 検索値2 & "*") Then

                '▼【B列全体】から【検索値1】が含まれるセルを全部探す
                Set MyRNG = 検索部(.Columns("B"), 検索値1)

                '▼検索値2が""だったら検索値1のみが含まれるセルでよい(検索値2を探す必要は無い)
                If 検索値2 <> "" Then
                    '▼【検索値1が含まれるセル】から【検索値2】が含まれるセルを全部探す
                    Set MyRNG = 検索部(MyRNG, 検索値2)
                End If

                '▼セル番地付きで表示
                MsgBox "【" & .Name & "】のB列に「" & 検索値1 & "」と「" & 検索値2 & "」を含むものが存在します。" & vbLf & _
                       MyRNG.Address(0, 0) & "を確認してください"
            Else
                '▼無かったことを表示
                MsgBox "【" & .Name & "】のB列に「" & 検索値1 & "」と「" & 検索値2 & "」を含むものは存在しません"
            End If
        End With

    End Sub
    '------------------------------------------------------------------------------------------------------
    Function 検索部(検索範囲 As Range, 検索値 As String) As Range
        Dim 発見セル As Range, bufRNG As Range
        Dim 最初のセル番地 As String       

        Set 発見セル = 検索範囲.Find(What:=検索値, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
        最初のセル番地 = 発見セル.Address
        Set bufRNG = 発見セル

        Do
            Set 発見セル = 検索範囲.FindNext(発見セル)
            If 発見セル.Address = 最初のセル番地 Then
                Exit Do
            Else
                Set bufRNG = Union(bufRNG, 発見セル)
            End If
        Loop

        Set 検索部 = bufRNG

    End Function

■3
したがって、コードで悩む前にステップ実行して、どの行で【何に対して】どんな命令をしているのかというのをチェックされたほうがよいと思います。
ついでに、最初に提示されたコードで↓は全部同じ意味になります。

 If OptionButton1.Value = True Then
 If OptionButton1.Value Then
 If OptionButton1 Then

さらに、そもそもオプションボタンを使っているということは、「OptionButton1」と「OptionButton2」は排他の関係になってませんか?
であれば、2つに分けて書かずとも、↓のようにいずれかがTrueであれば実行としてみてはどうでしょうか?

    Private Sub CommandButton21_Click()
        If OptionButton1 Or OptionButton2 Then
            Call 実験02
        End If
    End Sub

(もこな2) 2020/01/28(火) 15:29


コメント返信:

[ 一覧(最新更新順) ]


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