エクセルでキーワードを入力し、抽出・貼付する方法

質問

質問初心者なので説明が足りなかったらすみません。

エクセルで「データベース」sheetからキーワードを含む行を全て「抽出」sheetに貼り付けるというマクロを組みたいのですが、どうもうまくいきません。

(1)「抽出」sheetにキーワードを入力。
　　（例）　ベーコン

(2)「データベース」sheetから抽出。
　　（例）　日付　　　　　　項目　　　　　　　　　内容
　　　1　　2014/5/3　　冷凍食品　　ほうれん草とベーコンのバター炒め
　　　2　　2014/5/8　　冷凍食品　　牛肉コロッケ
　　　3　　2014/5/20　 加工食品　　2/1ベーコン（4枚入り）

　　　※　「ベーコン」と記載される行を全て抽出したい。つまり、1・3行。

(3)抽出した行を「抽出」sheetに値貼付。

上記のようにしたいのですが、私の知識では分からなかったので、分かる方がいれば教えてください。
ちなみに私はCountifで挑戦していたのですが、できるのでしょうか？

回答No.2

tom04

No.1です。
たびたびごめんなさい。

前回のコードで一部行が違っているところがありました。
↓のコードに変更してください。

Sub Sample2() 'この行から
Dim lastRow As Long, wS As Worksheet
Set wS = Worksheets("抽出")
lastRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > 3 Then
Range(wS.Cells(4, "A"), wS.Cells(lastRow, "C")).ClearContents
End If
With Worksheets("データベース")
If wS.Range("A1") <> "" Then
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row '←この行を入れ替え！
.Range("A1").AutoFilter field:=3, Criteria1:="*" & wS.Range("A1") & "*"
Range(.Cells(2, "A"), .Cells(lastRow, "C")).SpecialCells(xlCellTypeVisible).Copy wS.Range("A4")
.AutoFilterMode = False
End If
End With
End Sub 'この行まで

どうも失礼しました。m（_ _）m

お礼

回答ありがとうございました。
時間が掛かってしましましたが、このやり方で出来ました！＾＾
助かりました！

回答No.1

tom04

こんにちは！
一例です。

↓の画像のように「データベース」Sheetに作業用の列を設けます。
作業列E2セルに
=IF(ISNUMBER(FIND(抽出!A$1,C2)),ROW(),"")
という数式を入れフィルハンドルでずぃ～～～！っと下へコピーしておきます。
（COUNTIF関数でも対応できます）

そして、「抽出」SheetのA4セルに
=IF($A$1="","",IFERROR(INDEX(データベース!A:A,SMALL(データベース!$E:$E,ROW(A1))),""))
という数式を入れ、列・行方向にフィルハンドルでコピー！
（A列の表示形式は「日付」にしておきます）
これで画像のような感じになります。

※　VBAでやりたい場合は標準モジュールに↓のコードをコピー＆ペーストしてマクロを実行してみてください。

Sub Sample1() 'この行から
Dim lastRow As Long, wS As Worksheet
Set wS = Worksheets("抽出")
lastRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > 3 Then
Range(wS.Cells(4, "A"), wS.Cells(lastRow, "C")).ClearContents
End If
With Worksheets("データベース")
If wS.Range("A1") <> "" Then
.Range("A1").AutoFilter field:=3, Criteria1:="*" & wS.Range("A1") & "*"
Range(.Cells(2, "A"), .Cells(lastRow, "C")).SpecialCells(xlCellTypeVisible).Copy wS.Range("A4")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.AutoFilterMode = False
End If
End With
End Sub 'この行まで

※　注意点　※
VBAの場合は当然「作業列」は不要ですが、
「抽出」Sheetに関数が入っている場合、すべて消えてしまいますので
別Sheetで試してみてください。m（_ _）m