Excel VBA B列を検索して１行下をコピぺ

質問

はじめまして。

VBAを始めたばかりですが、自分ではどうにもならないので、教えていただければと思い、初めて質問致します。

A1～G1、１行目から1000行目まで各セルに数字がランダムに１つずつ入っているデーターSheet１があり、コマンドボタンを押すことによってMsgBoxに入力した数字をB列を下に検索していき、例えば、数字の8が入力されたら、B1から下にB列に8が出現したらそのセルの1つ下の行(A列～G列まで)をコピーしてSheet2に抽出したいと考えているのですが、なかなか出来ず、困っています。
イメージとして
A B C D E F G H I
1 5 14 30 25 30 3 9
2 22 34 6 7 29 49 3
3 1 8 20 4 10 6 45
4 30 15 34 50 2 5 9
5 11 8 45 7 6 20 1
6 40 8 48 25 36 4 10
7 21 22 30 28 6 7 36
8 2 3 50 2 1 43 6

と、データがSheet1に仮にあって、8が入力されたなら4行目の 30 15 34 50 2 5 9 と
6行目 40 8 48 25 36 4 10、7行目 21 22 30 28 6 7 36という様に抽出されてSheet2に
上から順に貼り付けられる様にしたいので、皆様の御知恵をお貸しいただければと
思っております。かなり複雑かとは思いますが、どうか宜しくお願いいたします。
FINDやOFFSET、IF文、ループ等を使ってみましたが私のレベルでは全く話になりませんでした。
まだVBAかけだしなもので、なるべ簡単なくプログラムでお願いいたします。

回答No.2

keithin · ベストアンサー

こういう文脈での「簡単」とは，大概の場合「１行ずつデータを舐め回して調べる」一番効率の悪い方法ですね。

手順：
コントロールツールボックス（Excel2007以降ではActiveXコントロール）のコマンドボタンをシート１に配置する
右クリックしてコードの表示を開始し，現れたシートに下記をコピー貼り付ける

private sub CommandButton1_Click()
　dim h as range
　dim res as variant
　dim i as long

　res = inputbox("Number")
’　if res = false then exit sub
’　if not isnumeric(res) then
’　　msgbox "INPUT NUMBER"
’　　exit sub
’　end if

　worksheets("Sheet2").cells.clearcontents
　for each h in range("B1:B" & range("B65536").end(xlup).row)
　if h.value - res = 0 then
　　i = i + 1
　　worksheets("Sheet2").cells(i, "A").resize(1, 7).value = cells(h.row + 1, "A").resize(1, 7).value
　end if
　next
end sub

「青い三角定規」ボタンをクリックしてデザインモードを終了し，コマンドボタンをクリックしてマクロを実行する。

＃「実際のエクセル」が，あなたがご質問に書かれたようではなくもっとふつーに「１行目に何かタイトル行」「２行目から実データ」だった場合は，もうちょっとだけ簡単な（汎用的な）書きぶりのマクロにする事もできました。

お礼

keithin様のおかげでうまく動作させる事が出来ました！
初めてネットで質問をさせていただいたのですが、こんなに的確でわかりやすい御答えを頂戴することが出来るとは正直思っていなかったので、感動致して居ります。keithin様のような方がいらっしゃるOKWAVEをこれから積極的に活用していきたいと考えております！というかkeithin様がすばらしいのですがね！
なにぶんVBAカケダシ文系人間なので、失礼の無い様にと思い、自分なりに理解してからということで、御返事に時間がかかってしまいました。どうにかこうにか理解しようとまだ頑張っているのですが、やっている事はなんとなくわかるのですがfor文の中身がちんぷんかんぷんで、変数やら代入やらの所で頭爆発してます。これからさらにVBA勉強頑張ります。本当に有難う御座いました！
ついでといっては申し訳ないのですが、アドバイスいただいた「もっとふつーに「１行目に何かタイトル行」「２行目から実データ」だった場合」というケースのマクロを御教えいただけないでしょうか？（タイトル行は数字列１、数字列2、・・・数字列7という感じで！？）
最初に書いてくださったプログラムとの差異を比較しつつ、今回の質問で使われている書式の内容を、理解だけでなく、習得してしまいたいと考えております。御手数でなければ、どうか宜しくお願い致します。

回答No.3

keithin

前回のマクロを消して次のマクロに入れ替えます。

private sub CommandButton1_Click()
　dim h as range
　dim res as variant

　res = application.inputbox("Number", type:=1)
　if res = false then exit sub

　worksheets("Sheet2").cells.clearcontents
　range("1:1").copy destination:=worksheets("Sheet2").range("A1")
　for each h in range("B2:B" & range("B65536").end(xlup).row)
　if h.value =res then
　　h.offset(1).entirerow.copy destination:=worksheets("Sheet2").range("A65536").end(xlup).offset(1)
　end if
　next
end sub

貼り付け先を１行ずつカウントアップしていくような無様なことをしなくてもよくなり，つねに「１番下の行の１つ下の空の行」に貼り付ければよくなりました。

＃参考：
「１行ずつ舐め回さない」（＝ループを回さない）マクロ
private sub commandbutton2_Click()
　dim res as variant
　res = application.inputbox("NUMBER", type:=1)
　if res = false then exit sub

　application.screenupdating=false
　with range("B1:B" & range("B65536").end(xlup).row)
　.offset(1, 6).value = .value
　end with
　range("H:H").autofilter field:=1, criteria1:=res

　worksheets("Sheet2").cells.clearcontents
　range("A:G").copy destination:=worksheets("Sheet2").range("A1")
　range("H:H").delete shift:=xlshifttoleft
　application.screenupdating=true
end sub

お礼

keithin様、素早い御返事有難う御座いました。どうにかこうにか最初のプログラムと2番目のプログラムを詳しく理解する事が出来ました。IsNumeric関数、Application.InputBoxとInputBox関数の違い、ForEachInNextとFor文の違い、マクロ記憶での記述とは違うSheet内データの消去法、シートの最終行から上にデータ行の最後の行の取得方法やコピーの仕方でもcopy命令を使わない代入によるコピー！？やentirerowでまた違ったり、回し方でもオブジェクトの回数分だったり変数を1つずつ増加させて行を移動していく方法であったりと、とにかく、色々な方法を御教授いただき、有難う御座います！3番目のプログラムはまだ理解出来ていませんが、マクロ記憶のプログラム程度しか知らなかった私を一歩踏み出させてくれたkeithin様には非常に感謝致しております！早速VBAの本を買ってきて読んでおります。まずは簡単なと思ったので、次は役立つわかりやすいサンプルがたくさん載っている本を買おうと思っています！VBA最高！！プログラム超面白い！これも全てkeithin様のおかげです！本当に有難う御座いました！

回答No.1

noname#252332

sheet1にuserformを挿入してtextbox1とcommandbutton1を貼りつけて

Private Sub CommandButton1_Click()
y2 = 1

For y1 = 1 To 1000
If TextBox1.Text = Sheet1.Cells(y1, 2) Then
For x = 1 To 7
Sheet2.Cells(y2, x) = Sheet1.Cells(y1 + 1, x)
Next
y2 = y2 + 1
End If
Next
End Sub

こんな感じで。y1は検索行、y2はコピー先、xはコピー用です。

お礼

御返事遅くなりました！なにぶんカケダシなもので、なにせ、inputbox関数はわかってもuserformには手を出していなくて、すみませんでした。inputbox関数を使って教えていただけたら嬉しいのですが、御手数でなければ宜しくお願い致します。