[[20180629131913]]　『エクセルマクロでの検索範囲の一部除外』（すけさん）　ページの最後に飛ぶ

『エクセルマクロでの検索範囲の一部除外』（すけさん）

エクセルマクロでの検索範囲について。

マクロについてアドバイスをいただきたく質問させていただきます。

シート検索でそのシートの一部列だけ検索の範囲にいれないやり方を教えてください。

 「シート名：データベース」から検索した文字列（複数検索も可）を含む行を別シート「シート名：検索ページ」に抽出するマクロを作りました。データベースには列としてはB2からL2までデータが打ち込まれていて、行は随時データを更新し増えていきます。抽出したデータは検索ページのB4から貼り付けられるようになっています。
その検索に使用しているマクロがこれです。

Public Sub Samp1()

 Dim rng As Range
 Dim v As Variant
 Dim sS As String, sF As String
 Dim j As Long
 Const CF As String = _
 "=IF(COUNTIF(RC[{%1}]:RC[-1],""*{%2}*"")>0,1,"""")"

 sS = InputBox("検索したい文字を入力してください。複数の条件で検索したい場合は「、」で区切ると検索できます。")
If (sS = "") Then Exit Sub

 Application.ScreenUpdating = False
 With Worksheets("データベース").UsedRange
 j = .Column
 With .Columns(.Columns.Count + 1)
 sF = Replace(CF, "{%1}", j - .Column)
 .Value = 1
 For Each v In Split(sS, "、", , vbTextCompare)
 With .SpecialCells(xlCellTypeConstants)
 .FormulaR1C1 = Replace(sF, "{%2}", v)
 End With
 .Value = .Value
 If (WorksheetFunction.Count(.Cells) = 0) Then Exit For
 Next
 On Error Resume Next
 Set rng = .SpecialCells(xlCellTypeConstants)
 On Error GoTo 0
 .ClearContents
 End With
 End With

 With Worksheets("検索ページ")
With .Rows(4)
 .Resize(Rows.Count - .Row).Clear
 If (Not rng Is Nothing) Then
 rng.EntireRow.Copy .Cells
 End If
 End With
 End With
 End Sub

今はシート：データベースのすべての範囲を検索範囲にしているのですが、今回はK列だけを検索範囲から除外したいと考えています。抽出して検索ページに張り付けられた際にはK列は表示されているものとし、検索範囲からのみの除外としたいです。

 改めて範囲を細かく指定した方がいいのか、K列だけ除外できる方法があるのかもわからない状態です。
どうか教えていただけないでしょうか。

＜使用 Excel：Excel2010、使用 OS：unknown ＞

 細かいとこは、適当に直して・・・・
 たぶんカッケー物（1行ですむとか）を希望なんだと思うけど、知らん。

 Dim Col As Range
 Dim NewRag As Range
 With ActiveSheet.UsedRange
    For Each Col In .Columns
        If Col.Column <> 11 Then
           If NewRag Is Nothing Then
              Set NewRag = Col
           Else
              Set NewRag = Union(NewRag, Col)
           End If
        End If
    Next
 End With
 NewRag.Select
 MsgBox NewRag.Address
（BJ） 2018/06/29(金) 14:00

データベースのすべての範囲を検索範囲にしているこれはCountIf関数が参照しているセル範囲ということですか？

そうだとすると関数に複数範囲は入れられそうにないので、
2段構えで数えることになりそうです。

ちょっと何をしているかコードを読んだだけではわかりませんので、
どういうことをしたいかを説明いただけると、
別のアプローチが出来るとは思います。

（まっつわん） 2018/06/29(金) 14:28

現在のコードでは
シートタブに“データベース”と“検索ページ”のふたつのタブがあります。
シート：データベースには
【例】
No/日付/会社名/氏名/関係/役職/香典/供花/弔電/参列者/備考
1 / 2.1/〇〇社/田中/本人/社長/〇円/ 〇/ 〇 /社長 /
2 / 3.5/△△社/鈴木/義父/会長/〇円/ ×/ ― /社長/
3 / 5.4/◇◇社/相沢/義母/専務/― / 〇/ × / ― /
・
・
・
のような表が書き込まれています。
シート：検索ページには検索ボタンがあり、それをクリックし検索したい文字列を打ち込むと
シート：データベースからその文字列が含まれる行が抽出され
シート：検索ページに表として現れるようになっています。

現状ではデータベースの表全体が検索範囲になっていますが、
この検索範囲から参列者の列だけ除外したいと考えています。
なお検索範囲には含めませんが、検索ページの抽出したあとの表には表示されて欲しいです。

初心者なので改変を試みてもうまくいきません…。
どう手助けのほどお願いいたします。

（すけさん） 2018/06/29(金) 15:48

たぶんですが、
【1】COUNTIF関数で１行まるごとの中にキーワードを含むセルがいくつあるのか見ておいて
【2】0より大きい（＝行内にキーワードを含むセルがある）場合、抽出対象の行に追加
ってことですよね。

それなら、
【1】１行丸ごとの中にキーワードを含むセルがいくつあるのか見ておいて（aとする）
【2】そのうち、除外したい範囲にキーワードを含むセルがいくつあるのか確認して（bとする）
【3】a-bが0より大きければ、抽出対象の行に追加
とすればいいんじゃないですか？

（もこな２） 2018/06/29(金) 16:47

　＞のような表が書き込まれています。
　＞データベースからその文字列が含まれる行が抽出され
こういうとき、エクセルにはフィルターオプションという機能が用意されています。
手動でこの操作を行うのは煩雑なうえ不細工ですが、
マクロでこの機能をコントロールするすると、少ないコード量で素早く抽出してくれます。
そして、マクロでコントロールするなら見せたい部分、見せたくない部分、さまざまに制御できますので、
すごく便利なのですが、
その機能を使うのはダメでしょうか？
知らなければ、一度調べてみることをお勧めします。

それとも、今の仕様のように、項目は指定せずに、
乱暴に、「会社名」や「役職」を羅列することで、
抽出出来て欲しいでしょうか？

（まっつわん） 2018/06/29(金) 19:51

  こんばんは！
＞シートタブに“データベース”と“検索ページ”のふたつのタブがあります。

 なので、現在の検索しているシートをコピーして
もう一つシートを追加します
そのシートではK列を削除してそのシートを検索してみてはどうでしょうか？
（SoulMan） 2018/06/29(金) 23:20

まっつわんさんがおっしゃる通り、オートフィルタなどで事足りるのであれば、そちらのほうがいいとおもいますけど・・・

2018/06/29(金) 16:47のアイデアをコード化してみました。
実行速度も悪くはない・・・・とおもいます。
※正規表現は不得手なので、簡略化しました。どうしても正規表現じゃなきゃダメっていう場合は、自力で直されるか、別の回答者さんをお待ちください。

    Sub 実験データ作成()

    '##　一度のみ実行のこと　##

        With Worksheets.Add
            .Name = "DB"
            .Range("A1:K1").Value = Split("No/日付/会社名/氏名/関係/役職/香典/供花/弔電/参列者/備考", "/")
            .Range("B2:K2").Value = Split("2.1/〇〇社/田中/本人/社長/〇円/〇/〇/社長/", "/")
            .Range("B3:K3").Value = Split("3.5/△△社/鈴木/義父/会長/〇円/×/―/社長/", "/")
            .Range("B4:K4").Value = Split("5.4/◇◇社/相沢/義母/専務/―/〇/×/―/", "/")
            .Range("B2:K4").AutoFill Destination:=.Range("B2:K1000"), Type:=xlFillDefault
            With .Range("A2")
                .Value = 1
                .AutoFill Destination:=.Resize(999), Type:=xlFillSeries
            End With
        End With

        With Worksheets.Add
            .Name = "出力用"
            .Range("A10:K10").Value = Split("No/日付/会社名/氏名/関係/役職/香典/供花/弔電/参列者/備考", "/")
        End With

    End Sub

    Sub サンプル()
        Dim a As Long, b As Long
        Dim WF As Object: Set WF = Application.WorksheetFunction
        Dim i As Long
        Dim tmp As String, MySTR As Variant
        Dim srcRNG As Range

        tmp = InputBox("キーワードを入力。複数の場合は,(半角カンマ)で区切ること")

        With Worksheets("DB")
            For Each MySTR In Split(tmp, ",")
                For i = 1 To .UsedRange.Rows.Count
                    a = WF.CountIf(.UsedRange.Rows(i), MySTR)
                    b = WF.CountIf(Intersect(.UsedRange.Rows(i), .Range("J:J")), MySTR)

                    If a - b > 0 Then
                        If srcRNG Is Nothing Then
                            Set srcRNG = .UsedRange.Rows(i)
                        Else
                            Set srcRNG = Union(srcRNG, .UsedRange.Rows(i))
                        End If
                    End If
                Next i
            Next MySTR
        End With

        If Not srcRNG Is Nothing Then
            With Worksheets("出力用")
                .Range(.Rows(11), .Rows(.Rows.Count)).ClearContents
                srcRNG.Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
            End With
        End If
    End Sub

（もこな２） 2018/06/30(土) 01:01

コメント返信：

[ 一覧(最新更新順) ]

[[20180629131913]] 『エクセルマクロでの検索範囲の一部除外』（すけさん） ページの最後に飛ぶ

[[20180629131913]]　『エクセルマクロでの検索範囲の一部除外』（すけさん）　ページの最後に飛ぶ