excel 別ブックのデータをvbaで(vlookup)参照をしたい

ファイルを共有するので別ファイルのリンクを切る必要があり、vbaで処理ができるようにしたいです

ファイルは２つで②のファイルにvbaを組込ませたいです
①参照先＝[masterファイル.xls]の[master1]シート
②書込先＝[○○支店.xls]の[xxxx(コード)_yyyy(西暦)]シート

＜条件＞
１．①の[master1]シートにはA列～X列の5行目から3000行目までデータが入っており
　　検索値＝F列
　　範囲＝F5:X3000
　　列番号＝18(W列)と19(X列)　　←2つのデータを取り出したい
２．①のW列とX列は関数が入っているので値だけ取り出したい
３．②のファイルには[xxxx(コード)_yyyy(西暦)]シートがあり、A～AD列の6行目～300行目あたりまでデータが追加されていきます
　　参照値＝Q列
　　取り出したデータの貼付け先＝AB列とAC列
４．①のファイルは一定量のデータが溜ると更新される(書換えられる)ので②のAB列やAC列のすでにデータが入ったセルはそのままで空欄となっているセルだけを埋めるようにしたい
５．ちなみに②は20ファイルくらいあるので、それぞれにvbaを組込ませる予定です(参照ファイルは①の１つだけです)
６．vbaは全くの初心者なので、条件が変わった場合に修正ができるように詳しい解説をお願いしたいです

どうぞよろしくお願いいたします

質問者からの補足コメント

• ありがとうございます
  
  ご指示いただきました通り実行したところ、①の参照先データに情報がないためのエラーのようです
  ”xxxx-xxxx-xx”←検索値（数字の羅列）
  ”なし”
  のメッセージが上がりました
  参照先も更新されるため最新のデータに対応しない状況です
  この場合、何もしないで次の検索に入る事は出来ますでしょうか？
  何度もお手数おかけして申し訳ないです
  どうぞよろしくお願い致します

  No.3の回答に寄せられた補足コメントです。 補足日時：2015/10/21 18:32

• 追記です
  
  試しに
  For i = 289 To 300
  へ変更（289行目以降には参照値が入っていない状態）したところ
  以降300行目までメッセージがOKと表示される状態でした
  参照値が空白のケースもあり得ます…
  
  全くわかっていなくてすいません

    補足日時：2015/10/21 19:57

No.5 回答者： hiro40199210 回答日時： 2015/10/22 14:09

テスト用のコードを作成しました。

２種類あります。
マクロ「SheetSet」は空のブックに模擬データを作ります。新規ブックに対して行ってください。
実際の業務用ブックでは、複雑な条件（関数や他ブックの参照など）があるため、要素を単純化した模擬データで問題解決していった方がいいような気がします。


処理
①Q5:Q3000にランダムな文字列「土・日・月」のいずれかを入力。
　検索に使います。

②W5:W3000に=row()*10
③X5:X3000に　=row()*100
この関数式の【値】を取り出すテストを行います。

④AB5:AB3000には、５行ごとに"データ”という文字列を入力します。
⑤AC5:AC3000には、３行ごとに"データ”という文字列を入力します。

次にマクロ「Test」を使って、動作確認をします。

やることは
５行目から３０００行目まで
【Q列の値が(土)の行 ＆ AB列の値が空白】→【W列の関数式の（値）をAB列に転記】
【Q列の値が(土)の行 ＆ AC列の値が空白】→【X列の関数式の（値）をAX列に転記】

Q列の値が(土)の行のAB:AC列に、W:X列の関数式の（値）を転記するわけです。

ただし、AB5:AB3000には、５行ごとに"データ” AC5:AC3000には、３行ごとに"データ”があります。
この文字列は消えません。

かなり単純な内容ですが、この模擬ブックとコードを元に、少しずつ改良していけたらと思います。


-----------------------------------------------------------------------
Sub SheetSet()

Dim i As Long
Cells.Clear

For i = 5 To 3000

Cells(i, "Q") = Int(Rnd() * 3)
Cells(i, "W").Formula = "=row()*10"
Cells(i, "X").Formula = "=row()*100"

If i Mod 5 = 1 Then
Cells(i, "AB") = "データ"
End If

If i Mod 3 = 1 Then
Cells(i, "AC") = "データ"
End If

Next

Columns(17).AutoFit
Range("Q:Q").NumberFormatLocal = "AAA"
Range("W:X").EntireColumn.AutoFit
Range("A:P").EntireColumn.ColumnWidth = 0.1
Range("R:V").EntireColumn.ColumnWidth = 0.1
Range("Y:AA").EntireColumn.ColumnWidth = 0.1

For i = 5 To 3000
If Cells(i, "Q") = 0 Then
Cells(i, "Q").Interior.Color = vbCyan
End If
Next
End Sub
-----------------------------------------------------------------------


-----------------------------------------------------------------------
Sub Test()
Dim i
Dim fRange1 As Range
Dim fRange2 As Range

Set fRange1 = Cells.Find("土", LookIn:=xlValues)

If fRange1 Is Nothing Then
MsgBox ""
Exit Sub
Else

Set fRange2 = fRange1

If Cells(fRange2.Row, "AB") = "" Then
Cells(fRange2.Row, "AB").Value = Cells(fRange2.Row, "W")
End If
End If

If Cells(fRange2.Row, "AC") = "" Then
Cells(fRange2.Row, "AC").Value = Cells(fRange2.Row, "X")
End If

Do
Set fRange2 = Cells.FindNext(fRange2)
If fRange1.Address = fRange2.Address Then
Exit Do
Else

If Cells(fRange2.Row, "AB") = "" Then
Cells(fRange2.Row, "AB") = Cells(fRange2.Row, "W")
End If

If Cells(fRange2.Row, "AC") = "" Then
Cells(fRange2.Row, "AC") = Cells(fRange2.Row, "X")
End If

End If
Loop

End Sub
-----------------------------------------------------------------------

No.4 回答者： hallo-2007 回答日時： 2015/10/21 21:08

一例です。

For i = 6 To 300
If .Columns("F:F").Find(Range("Q" & i).Value, LookAt:=xlWhole) Is Nothing Then
Range("AB" & i).Value="該当なし"
Else
　Range("AB" & i).Value = .Columns("F:F").Find(Range("Q" & i).Value, LookAt:=xlWhole).Offset(0, 17).Value
・・・・
End IF
最終行が３００と限らない場合は
For i = 6 To Rnage("Q" & Rows.Count).End(xlup).Row

Rows.Countは、そのシートに持っている行数です。
Excel2007以上のバージョンでは　約100万行
End(xlup).
Q列の一番下から上へ移動して空白で亡くなる
Row
その行番号です。

この回答へのお礼

出来ました！
ありがとうございます
これをベースにカスタマイズしていきます
何度も相談に乗っていただき本当にありがとうございました

お礼日時：2015/10/22 19:07

No.3 回答者： hallo-2007 回答日時： 2015/10/20 21:28

ん～、たぶんですが、検索の値が見つからないのでは

エラーが出て、黄色で表示されている状態で
Range("AB" & i).Value = .Columns("F:F").Find(Range("Q" & i).Value, LookAt:=xlWhole).Offset(0, 17).Value
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　↑
矢印の部分にマウスを移動させると、その時の値が表示されます。
確認してみてください。

For i = 6 To 300
Msgbox Range("Q" & i).Value
If .Columns("F:F").Find(Range("Q" & i).Value, LookAt:=xlWhole) Is Nothing Then MsgBox "なし"
Range("AB" & i).Value = .Columns("F:F").Find(Range("Q" & i).Value, LookAt:=xlWhole).Offset(0, 17).Value

とかにして、確認してみてください。
見つからないときのエラー処理を加える事になります。

No.2 回答者： hallo-2007 回答日時： 2015/10/19 21:18

分かりやすい所からですが

①と②のファイルが同じフォルダーある。
②のファイルの[xxxx(コード)_yyyy(西暦)]シートが開いている状態

Sub ボタン1_Click()
Workbooks.Open Filename:=ThisWorkbook.Path & "\master.xlsx"
ThisWorkbook.Activate
With Workbooks("master").Sheets("master1")
For i = 6 To 300
Range("AB" & i).Value = .Columns("F:F").Find(Range("Q" & i).Value, LookAt:=xlWhole).Offset(0, 17).Value
Next
End With
Workbooks("master").Close SaveChanges:=False
End Sub
を実行してみてください。
①ファイルのF列を検索して、同じものがみつかったら、右へ１７列移動した値をAB列に入れる
と云う事です。
エラー処理も何もしていませんので、たたき台として理解してみてください。

この回答へのお礼

ありがとうございます

早速やってみましたが、
Range(”AB”&i).value〜で
『オブジェクト変数またはWithブロック変数が設定されていません』
というエラーが出てしまいます

どのように追記すべきがご教授いただければと思います
またファイル名などは実際に合わせて変更しております
→Thisworkbooks(”master160.xls”)など

どうぞよろしくお願いします

お礼日時：2015/10/20 18:54

No.1 回答者： hallo-2007 回答日時： 2015/10/18 10:48

ちょうど暇なので、お付き合いします。

（ご覧になっておられれば）
確認
１　元データのファイル（約3000行）
　　F　　・・・・　　W　　X
　検索値　　　　　内容１　内容２

２　抽出先データのファイル（約300行）
　　Q　・・・・　　AB　　AC
　参照値　　　　　内容１　内容2

Vlookup関数ではダメだったのでしょうか？
AB列に
=Vlookup(Q6,元データのファイル!F:X,18,False)　下へコピーしておいておく
ではダメなのですか？

この回答へのお礼

回答ありがとうございます
リンクを切る必要があるのでマクロにしたいんです…
現在は、編集の度にvlookup関数を入れてリンク切りの作業を続けています

条件が多いので難しいでしょうか…

お礼日時：2015/10/19 16:30