VB初心者です。

質問

二つのブックを開いているときに。
１のブックの指定の文字を含む行のみを２のブックに参照していく作業をしたいのですが、色々webで探していたのですが、いまいちよくわからなかったので質問させていただきました。

やりたい内容

(1)　ブック１とブック２を同時に開いている

(2)　ブック２でVBを実行する

(3)　ブック１の１列目を参照して任意の文字ががある場合にブック２の１行目からどんどんコピペしていく

ブック１

１列目　　２列目　　３列目　　４列目　　５列目
指定　　　あ　　　　 い　　　　 う　　　　　え
不一致　 か　　　　 き　　　　 く　　　　　け
不一致　 さ　　　　　し　　　　 す　　　　 せ
指定　　　た　　　　 ち　　　　 つ　　　　 て

ブック２

１列目　　２列目　　３列目　　４列目　　５列目
指定　　　あ　　　　 い　　　　 う　　　　　え
指定　　　た　　　　 ち　　　　 つ　　　　 て

このような状態にしていきたいのですが、お分かりになる方いらっしゃいましたら、お力添え頂ければ幸いです。
よろしくお願い致します。

回答No.6

piroin654 · ベストアンサー

#2、#4です。

同様のいくつかの事例をあげておきます。
http://oshiete1.watch.impress.co.jp/qa6439871.html
http://oshiete1.watch.impress.co.jp/qa6447162.html
これで少しプログラムの中で何をしているか、
あるいは応用などが分かると思います。

考えていくと、ループの渦の中に巻き込まれて
出口がわからなくなるものです。特に
多重ループの場合は、途中で条件を挟まなければ
ならない場合は、めまいをを起こしそうになります。

こうした、多重ループの扱いは慣れもありますが、
データの流れを

If wk1.Sheets("sheet1").Cells(1, 1).Value = "指定" Then

wk2.Sheets("sheet1").Cells(1, 1) = wk1.Sheets("sheet1").Cells(1, 1).Value
wk2.Sheets("sheet1").Cells(1, 2) = wk1.Sheets("sheet1").Cells(1, 2).Value
wk2.Sheets("sheet1").Cells(1, 3) = wk1.Sheets("sheet1").Cells(1, 3).Value
wk2.Sheets("sheet1").Cells(1, 4) = wk1.Sheets("sheet1").Cells(1, 4).Value
wk2.Sheets("sheet1").Cells(1, 5) = wk1.Sheets("sheet1").Cells(1, 5).Value
wk2.Sheets("sheet1").Cells(1, 6) = wk1.Sheets("sheet1").Cells(1, 6).Value
End If

If wk1.Sheets("sheet1").Cells(3, 1).Value = "指定" Then

wk2.Sheets("sheet1").Cells(3, 1) = wk1.Sheets("sheet1").Cells(3, 1).Value
wk2.Sheets("sheet1").Cells(3, 2) = wk1.Sheets("sheet1").Cells(3, 2).Value
wk2.Sheets("sheet1").Cells(3, 3) = wk1.Sheets("sheet1").Cells(3, 3).Value
wk2.Sheets("sheet1").Cells(3, 4) = wk1.Sheets("sheet1").Cells(3, 4).Value
wk2.Sheets("sheet1").Cells(3, 5) = wk1.Sheets("sheet1").Cells(3, 5).Value
wk2.Sheets("sheet1").Cells(3, 6) = wk1.Sheets("sheet1").Cells(3, 6).Value
End If

のように、変数を入れずにデータを入れてみると
よくわかります。

お礼

お返事遅くなってしまい申し訳ありません。

ご丁寧にありがとうございます。

書いて頂いたコードを入力してやりたかったことはすべてできました。

自分でも少しずつできるようにしていきますが、また何かわからないことがありましたら、その際は何卒よろしくお願いいたします。

回答No.5

layy

「いまいちよくわからなかった」
この解き方を習得し、理解しておかないと、
下手すると、いつまでたっても「わからない」に陥ります。

いつでもサンプルを作ってくれる人がいる、わけでもないので、
がんばりましょう。
いろいろ質問できるのも今のうちです。

下記、よく使うところです。この類のページを探しておくこと。

http://www.asahi-net.or.jp/~zn3y-ngi/

http://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub04_200.html

お礼

お返事遅くなってしまい申し訳ありません。
貼り付けて頂いたページ等をこれからは参考にしながらがんばってみます。
貴重なご指摘ありがとうございました。

回答No.4

piroin654

#2です。変数の初期値と変数を変更しておきます。

Sub test5()
Dim L1 As Long
Dim R1 As Long
Dim R2 As Long
Dim x As Long
Dim y As Long
Dim wk1 As Workbook
Dim wk2 As Workbook
Dim strPath As String

'変数の初期化
R2 = 0

'パスの設定
strPath = ThisWorkbook.Path & "\Book2.xls"

'ブックの設定
Set wk1 = ThisWorkbook
Set wk2 = Workbooks.Open(strPath)
x = wk1.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row '最終行
y = wk1.Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column '最終列

'処理開始
'
For R1 = 1 To x
If wk1.Sheets("sheet1").Cells(R1, 1).Value = "指定" Then
R2 = R2 + 1
For L1 = 1 To y
wk2.Sheets("sheet1").Cells(R2, L1) = wk1.Sheets("sheet1").Cells(R1, L1).Value
Next L1
End If
Next R1

End Sub

それから、少しコードの説明をしておきます。
以下のコードをみてください。

Sub test6()
Dim L1 As Long
Dim R1 As Long
Dim x As Long
Dim y As Long
Dim wk1 As Workbook
Dim wk2 As Workbook
Dim strPath As String

'変数の初期化

'パスの設定
strPath = ThisWorkbook.Path & "\Book2.xls"

'ブックの設定
Set wk1 = ThisWorkbook
Set wk2 = Workbooks.Open(strPath)
x = wk1.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row '最終行
y = wk1.Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column '最終列

'処理開始
For R1 = 1 To x
For L1 = 1 To y
If wk1.Sheets("sheet1").Cells(R1, 1).Value = "指定" Then
wk2.Sheets("sheet1").Cells(R1, L1) = wk1.Sheets("sheet1").Cells(R1, L1).Value
End If
Next L1
Next R1

End Sub

このコードを実行すると、A列に「指定」という文字があれば
その行をBook2にコピー＆ペーストしていきます。しかし、
行はBook1と同じ設定になっているので、Book1で次の
「指定」の行が飛んでいればBook2には同じように
行間が飛んでコピーされます。
普通に考えればこれで用は足りのですが、質問の場合は
行間を詰めてコピーをしたい、ということのようなので、
Book2側でペーストする位置を独自に設定する必要が
あります。

そこで、test5では、上記のtest6のコードにBook2の行の位置を設定
する変数R2を加え、test6の

wk2.Sheets("sheet1").Cells(R2, L1) = wk1.Sheets("sheet1").Cells(R1, L1).Value

を、test5では

wk2.Sheets("sheet1").Cells(R2, L1) = wk1.Sheets("sheet1").Cells(R1, L1).Value

に変更し、もし「指定」の文字があったらR2の値を
For L1 = 1 To y　～　Next L1　の
ループに入る前に1加えて独自に行を移すようにしています。
R2の初期値は0なので、最初にBook1で「指定」文字が
10行目に見つかってもBook2には最初の行にデータが
ペーストされるようになっています。

コード自体は難しいことをしているのではありませんが、
二重のループで行移動と列の移動による処理を
しています。

回答No.3

layy

コピーできればいいのでなくて、
コピーさせるときの各ブックやシート、セルの指定の仕方とか繰り返しの仕方、命令がわからない、というのであれば、
事例からさらに条件つけるなどアレンジして自分で新たに作って見ましょう。その方がプログラミング能力アップになります。コード例はカンニングだ、みたいな感じでもいいんです。

回答No.2

piroin654

解決したでしょうか。
以下は質問の内容に即した方法です。
一応以下では二つのBookは同じフォルダにあるものとして、
strPath = ThisWorkbook.Path & "\Book2.xls"
としています。実際に合わせて変更してください。
変更する場合は、フルパスで設定します。たとえば、

strPath = "C:\Documents and Settings\user\デスクトップ\ファイル置場\Book2.xls"

のように指定します。

Sub test5()
Dim L1 As Long
Dim R1 As Long
Dim R2 As Long
Dim x As Long
Dim y As Long
Dim wk1 As Workbook
Dim wk2 As Workbook
Dim strPath As String

'変数の初期化
R2 = 1

'パスの設定
strPath = ThisWorkbook.Path & "\Book2.xls"

'ブックの設定
Set wk1 = ThisWorkbook
Set wk2 = Workbooks.Open(strPath)
x = wk1.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row '最終行
y = wk1.Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column '最終列

'処理開始
For R1 = 1 To x
If wk1.Sheets("sheet1").Cells(R1, 1).Value = "指定" Then
For L1 = 1 To y
wk2.Sheets("sheet1").Cells(R2, L1) = wk1.Sheets("sheet1").Cells(R1, L1).Value
Next L1
R2 = R2 + 1
End If
Next R1
End Sub

回答No.1

layy

ＶＢＡでやるなら
－－－－－－－－－－－－－－
シート１：Ａ１を選択
シート２：Ａ１を選択

◆
シート１：選択セルが「指定」となっているか

→なっているとき
→シート２の選択位置にシート１の選択行の値をセットする
→シート２：１行下（のＡ２）を選択

→なっていないとき
→シート１：１行下（のＡ２）を選択

→◆から繰り返し

シート１の選択セルに何もないとき終了

－－－－－－－－－－－－－－
こんな感じでしょう。

結果としては、
「指定」でフィルタをして、それをシート２へ貼り付け、と同じでしょうか。
それならＶＢＡ結果と照合してみてください。

ＶＢＡの投稿なのでＶＢＡで頑張ってみてください。