EXCEL VBA 文字 含む 含まない 実行

質問

マクロ初心者です。
どなたか下記内容のマクロを組みたいのですが、ご教授いただけますでしょうか？

内容
ファイルBのK列には、F・G・Pの記号がランダムに入力されています
(各記号は入力されて無い場合があり)

1.ファイルAとファイルBを開き、ファイルBのK列に文字Pが含まれない検索をかけ、該当した場合2へ　該当無しの場合2’へ　
2.条件　K列にPを含まないでオートフィルターかけます。
表示されているA2以下の内容をファイルAのA2に貼り付ける
2’.次の処理に移行する
3.ファイルBのK列に文字Pが含まれるで検索をかけ、
該当した場合4へ　該当無しの場合4’へ　
4.条件　K列にPを含むでオートフィルターかけます。
表示されているA2以下の内容をファイルAのA58に貼り付けるマクロを終了する
4’マクロを終了する

下記プログラムを組んでみましたがうまくいきません。
Sub()
Dim row As Integer
row = Range("A" & Rows.Count).End(xlUp).row
Book_B.Activate
Columns("K").Select
If InStr(ActiveCell, "P") = 0 Then ' Pが含まれない
　 Range("A2").Select
　 Selection.AutoFilter
　 Selection.AutoFilter Field:=11, Criteria1:="<>*P*", Operator:=xlAnd
　Range("B2:E" & row).Select
　Selection.Copy
　Book_A.Activate
　Range("C4").Select
　Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
　Book_B.Activate
　Selection.AutoFilter
End If
Book_B.Activate
Columns("K").Select
If InStr(ActiveCell, "P") > 0 Then ' Pが含まれる
　Range("A2").Select
　Selection.AutoFilter
　Selection.AutoFilter Field:=11, Criteria1:="=*P*", Operator:=xlAnd
　Range("C2:C" & row).Select
　Application.CutCopyMode = False
　Selection.Copy
　Book_A.Activate
　Range("E58").Select
　Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End Sub

回答No.3

OtenkiAme

こんにちは。

補足ですが、もし、

> If InStr(Range("K2:K91").Value, "P") = 0 Then

という処理を行うのなら、ワークシート関数のCOUNTIF関数を使って

If Application.WorksheetFunction.CountIf(Columns("K:K"), "P") = 0 Then

を使えばいいと思います。

回答No.2

OtenkiAme

こんにちは。

> If InStr(Range("K2:K91").Value, "P") = 0 Then
Instr関数のstring1やstring1に指定できるのは文字列式であって、ActiveCell.Valueなら単一の値になりますが、複数のセル範囲の値をまとめて指定することはできません。

それで、Range("K2:K91").Valueの範囲を探して改めてフィルタをかけるのではなく、
最初にフィルタをかけて、該当するデータがあったらコピーする、という処理にされては如何ですか。

AutoFilterをかけると、WorksheetのAutoFilterプロパティで、その範囲のデータだけ調べられるようになりますから、見出し以外にデータがあればコピーするという処理にすればいいと思います。

Worksheets(1)は、質問者さんの環境に合わせて修正してください。

Sub test()

Dim myRow As Long

'Book_BのWorksheets(1)で
With Book_B.Worksheets(1)

　　'A列の最終行を取得する
　　myRow = .Range("A" & .Rows.Count).End(xlUp).row

　　'K列の定数セル範囲で"P"が含まないデータを抽出する
　　.Columns("K:K").SpecialCells( _
　　　　xlCellTypeConstants, 23).AutoFilter Field:=1, Criteria1:="<>*P*"

　　'抽出データがあったら
　　If .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
　　　　'B2からE列の最終行までコピーして
　　　　.Range("B2:E" & myRow).Copy
　　　　'Book_AのWorksheets(1)のC4セルに値貼り付け
　　　　Sht_A.Range("C4").PasteSpecial Paste:=xlPasteValues
　　End If

　　'K列の定数セル範囲で"P"を含むデータを抽出する
　　.Columns("K:K").SpecialCells( _
　　　　xlCellTypeConstants, 23).AutoFilter Field:=1, Criteria1:="=*P*"

　　'抽出データがあったら
　　If .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
　　　　'C2からC列の最終行までコピーして
　　　　.Range("C2:C" & myRow).Copy
　　　　'Book_AのWorksheets(1)のE58セルに値貼り付け
　　　　Book_A.Worksheets(1).Range("E58").PasteSpecial Paste:=xlPasteValues
　　End If

　　Application.CutCopyMode = False

　　'オートフィルタを解除
　　.AutoFilterMode = False

End With

End Sub

お礼

OtenkiAmeさん
お礼が遅くなりましたが連絡が遅くなり申し訳ございません。
今日いろいろ他のも含めチャレンジしてうまくいきました。
とても勉強になりました。
今後マクロ頑張って勉強してみます。
本当にありがとうございました。

回答No.1

OtenkiAme

こんにちは。

どこがうまくいっていないのか書かれていないので、ざっとみて気になったところを書きます。

　変数に指定している row は、VBAですでに使われている予約語ですから別の名前にしてください。

　その変数を　As Integer　と整数型で宣言していますが、その範囲は、-32,768～32,767の範囲しか使用できません。このマクロを実行するブックのワークシートの行数は、Integer型で取得可能ですか？　As Long　と長整数型で宣言した方が無難ではないですか？

　Columns("K").Selectと書いていますが、正しい記述ですか？（K列を選択する処理を記録して確認してみてください。）

　K列を選択した直後、Activecellは、K1セルになりますが、Instr関数の中で　Range("K1").Value　と明確に書かないで　ActiveCell　と書いているのは、意図があるんですか？

　ワークシート名が全く記述されていませんが、大丈夫なんですか？

補足

OtenkiAme様
ご回答・ご指摘ありがとうございます。
ご指摘のrowとAs　Longについて修正しました。
Columns("K").SelectについてはColumns("K:K").Selectでした。
ご指摘ありがとうございます。（ネットで調べたのですが間違っていたようです）
ワークシート名については、質問用にあえて編集しておりまして
実際はBook_AはThisWorkbook・Book_BはTmpBook（開いたブック）で指定しており問題なく動作しております。

Activecellの箇所を下記コマンドに修正しましたが（型が一致しない）と表示されるですがどこかおかしいでしょうか？

If InStr(Range("K2:K91").Value, "P") = 0 Then　

素人的質問で大変申し訳ないのですが、宜しくお願いいたします。