プロが教える店舗&オフィスのセキュリティ対策術

いつも楽しく拝見しております。

すいません、ネットで頑張って調べたのですが、どうしても
ウマくいかないので、ご教授下さい。

エクセルにて、シート1にさまざまな情報が記載されています。
A1を検索ボックスとし、ここに入れた言葉を検索し、対象となった行のみをシート2にコピーしたいと考えています。
※書式もそのままコピーしたいです。

これをマクロにて作成し、使用者にはA1に検索内容を入れてもらった後、マクロが仕込んであるボタンをクリックすれば結果が出てくる・・・と言う形を作りたいです。

検索のみ、コピーのみであれば、それぞれ調べると乗っていたりするのですが、両方をしようとした時、どのような式が必要かがわかりません。

ちなみに、検索は以下のような記述を見つけました。

On Error Resume Next
a = InputBox("検索したい文字を入力してください。")
Cells.Find(what:=a, after:=ActiveCell, LookIn:=xlFormulas, lookat:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, MatchByte:=False, SearchFormat:=False).Activate
End Sub

どのような記述を行えば出来るのでしょうか。
また、参考文献が掲載されているURLでも結構です。

どうかご教授下さい。

宜しくお願い致します。

A 回答 (2件)

>A1を検索ボックスとし、ここに入れた言葉を検索し、



>a = InputBox("検索したい文字を入力してください。")
がかみ合いませんが。

Findメソッドでのデータ検索 
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/v …
この事ではないかと。

データの範囲及びシート2の貼付ける位置が不明ですが。
InputBoxで値を入力し、シート1の全セルを検索範囲とし、シート2の1行目に貼付けるとするなら、

Sub try()
Dim str As Variant
Dim r As Range

str = InputBox("検索したい文字を入力してください。")

If str = "" Then Exit Sub

Set r = Worksheets("Sheet1").Cells.Find(What:=str, LookIn:=xlValues, _
LookAt:=xlWhole)

If r Is Nothing Then Exit Sub

r.EntireRow.Copy Worksheets("Sheet2").Rows(1)
Set r = Nothing
End Sub

こんなとか?
    • good
    • 0
この回答へのお礼

早速のご回答ありがとうございました。

早速試してみました。

まさにこんな感じのことがしたかったです!!

一点教えて頂きたいのですが、これは検索結果が複数あった場合、
コピーが出来ないのでしょうか。

出来れば、検索した内容が含まれている行ごと、なおかつ複数ある
場合は全てを貼り付けたいのですが、可能でしょうか。

ご教授頂けますと幸いです。

ご回答ありがとうございました。

お礼日時:2009/01/30 11:06

#1です。



>一点教えて頂きたいのですが、これは検索結果が複数あった場合、
>コピーが出来ないのでしょうか。
>出来れば、検索した内容が含まれている行ごと、なおかつ複数ある
>場合は全てを貼り付けたいのですが、可能でしょうか。

Sub try_next()
Dim str As Variant
Dim r As Range
Dim r1 As Range, r2 As Range

str = InputBox("検索したい文字を入力してください。")

If str = "" Then Exit Sub

Set r = Worksheets("Sheet1").Cells.Find(What:=str, LookIn:=xlValues, _
LookAt:=xlWhole)

If r Is Nothing Then Exit Sub

Set r1 = r
Set r2 = Worksheets("Sheet2").Range("A1")

Do
r.EntireRow.Copy r2.EntireRow

Set r = Worksheets("Sheet1").Cells.FindNext(r)
Set r2 = r2.Offset(1)
Loop Until r.Address = r1.Address

Set r = Nothing
Set r1 = Nothing
Set r2 = Nothing

End Sub

こんな感じの事でしょうか?
    • good
    • 1

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています