VBAで別ブックからVLOOKUPで抽出

質問

ブックBシート１A列の値にマッチする値をそれぞれの列にVLOOKUPでブックAシート１にある値から貼り付けたいのですがVBAコードが解る方宜しくお願いします。尚、データーが50行ぐらいあるのですが。

回答No.3

real beatin（@realbeatin） · ベストアンサー

＃１です。漏れがありましたので、追加回答です。

＃１のマクロでは、
ブックBの[年齢]列にだけ結果が返る、内容になっていましたが、
ブックBの[氏名]列と[年齢]列の２列に結果が返るように書くべきでしたので、
＃１のマクロをすべて、下に示すものと差し換えてください。
うっかりしてました。すみません。

ついでに、一応、
> ■ブックAが開いている状況からマクロを実行する前提　だけど、
>　　▲開いていなくても動作するように書きました。
ブックAが開いて居ない場合は、ブックAが開いてから処理する、という意味です。

結果として残したいものが"固定値"ではなく"数式"であるならば、
考える必要もないことですが、、、。
シート上に数式を出力する方法、については、
固定値を出力する目的であったとしても、
現代的な Excel VBA としては、寧ろ一般的な方法で、
演算結果を確定するまでの時間が短い、という特長があり、
同じ様にExcelの関数（数式）を用いるWorksheetFunctionとは、
大きく性格が異なり、パフォーマンスにも違いがあります。
他の有力な方法としては、Excelの関数（数式）を用いずに、
　ＶＢＡでメモリ上で演算した結果を返す方法や
　Excel一般機能の[検索]=.Findメソッドを使う方法など
も非常に有力な方法として考えられますが、
シート上で数式を演算させる方法は、
構文的に簡潔ですし、パフォーマンスも十分ですし、
今回は「VLOOKUPで」という指定でしたので、
このような方法を選択しています。

シート上で数式を演算させる方法、の難点、注意点としては、
文字列である"数式"を整形する時にミスし易いこと、が挙げられます。
よくあるのが、
1.　数式内で文字列値を指定する時の二重引用符の書き方。
　　　"=""abc"""
　　　"=IF(A1,1,"""")"　
　　　と書くべきものを誤って
　　　"=ABC"
　　　"=IF(A1,1,"")"
　　　とか、
2.　数式内で外部シートを参照する時の書き方。
　　　='D:\フォルダ\[ブックA.xlsm]Sheet1'!$A$2、
　　　='Sheet1 (2)'!$A$2、
　　　と書くべきものを誤って
　　　=D:\フォルダ\[ブックA.xlsm]Sheet1!$A$2、
　　　=Sheet1 (2)!$A$2、
　　　とか、
今回は二重引用符は関係ありませんし、
シートへの参照方法も数式に使える形の記述を
Excel側に問い合わせた結果を用いているので、
この点はミスが無いよう工夫しています。
セル範囲や引数の指定だけは確認の必要がありますけれど。

以下、差し替え、を、お願いします。

' ' /// ブックB に記載するマクロ　２個 ///　改

Sub Re8984933w()
　　Dim sRefSrc As String

' ' ブックA
On Error GoTo errH_　'　ブックA が開いていない場合のエラートラップ
　　' ' 要確認★ブック名 "ブックA.xlsm" ?　拡張子を確認して正確に！★シート名 "Sheet1" ?
　　With Workbooks("ブックA.xlsm").Sheets("Sheet1")
On Error GoTo 0　'　エラートラップ解除
　　　　' ' 要確認★先頭列番地(３ヶ所) A ?★[年齢]列までの列数 .Resize(, 3) ?
　　　　sRefSrc = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Resize(, 3).Address(True, True, xlA1, True)
　　End With

' ' ブックB
　　With ThisWorkbook.Sheets("Sheet1")　'　要確認★ブックB:処理結果を反映させたいシート名 "Sheet1" ?
　　　　' ' 要確認★先頭列番地(３ヶ所) A ?★[年齢]列までの相対列位置 .Offset(, 1) ?
　　　　With .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Offset(, 1).Resize(, 2)
　　　　　　' ' 要確認★ブックB:先頭列番地 A ?★ブックA:[年齢]列までの列数 ,3 ?
　　　　　　' ' 要確認 ブックA:先頭列から見た★[氏名]列の列位置 ,2 ?★[年齢]列の列位置 ,3 ?
　　　　　　.Formula = Array( _
　　　　　　　　　　　　"=VLOOKUP(A2," & sRefSrc & ",2,0)", _
　　　　　　　　　　　　"=VLOOKUP(A2," & sRefSrc & ",3,0)" _
　　　　　　　　　　　　)
　　　　　　' ' 数式の結果を値として残す場合は直下の行を　イキ
'　　　　　　.Value = .Value
　　　　End With
　　End With

Exit Sub
errH_:
　　OpenBookA
　　Resume
End Sub

Private Sub OpenBookA()
　　' ' 要指定★ブックAのフォルダパス　例示は「このブックのフォルダパス + \」　末尾の \ を忘れずに！
　　' ' 要確認★ブックAのブック名 "ブックA.xlsm" ?　拡張子を確認して正確に！
　　Workbooks.Open ThisWorkbook.Path & "\ブックA.xlsm"
End Sub

' ' ///

お礼

追加説明ありがとうございます。
列はWith .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Offset(, 2)
.Formula = "=VLOOKUP(A2," & sRefSrc & ",3,0)"
.Value = .Value '　☆
End Withを追加していったらなんとか出来ましたけど補足のコードのほうがよいですね。
助言も含めて本当にありがとうございました。

回答No.2

imogasi

（通常のケース）
VBAでエクセルシート関数を使うやり方はＶＢＡを使うものには常識だろう。
Application.WorksheetFunction.VLookup・・
のように書く
同一シート内に「表引きするデータ」がある場合。
Sub test01()
Set sh1 = ThisWorkbook.Sheets("Sheet1")
rl = sh1.Range("A1000").End(xlUp).Row
MsgBox rl
For i = 2 To rl
MsgBox sh1.Range("A" & i)
With sh1
st = Application.WorksheetFunction.VLookup(sh1.Range("A" & i), sh1.Range("D2:E8"), 2, False)
MsgBox st
Range("B" & i) = st
End With
Next i
End Sub
ーー
２．（別シートにある場合）
　「表引きするデータ」が同一ブックの別シートにある場合。コード略。
３．（別ブックにある場合）
　「表引きするデータ」が別ブック（したがって別シート）にある場合。
４．（上記でエラーだ起こらない家庭の場合）
５．（上記でエラーが起こっても次行分の検索を続行）
などかあり得て、順に少しずつむつかしくなる。
ーー
５．の線で
下記コード例。
ーーー
余り使い慣れないのでエラー処理で手こずったが、下記でどうだろう。
Sub test06()
On Error Resume Next
'--点数をセットするブック・シート
Set wb1 = Workbooks("VLOOKUPVBA")
Set sh1 = wb1.Sheets("Sheet1")
'--点数を採ってくるブック・シート
Set wb2 = Workbooks.Open("C:\Users\惇\Documents\点数例１.xlsx")
Set sh2 = wb2.Sheets("Sheet1")
'－－点数をセットするシートのA列の最下行
rl = sh1.Range("A1000").End(xlUp).Row
'--探索開始
For i = 2 To rl
'点数を採ってくる氏名ごと繰り返し

st = Application.WorksheetFunction.VLookup(sh1.Range("A" & i), sh2.Range("A2:B8"), 2, False)
If Err Then
sh1.Range("B" & i) = "なし"
Err.Clear
GoTo nt2
Else

'点数をセットするブック・シートのセルに点数をセット
sh1.Range("B" & i) = st
MsgBox "探索= " & sh1.Range("A" & i) & "　点数= " & st
End If
nt2:
Next i
GoTo nt1
'--エラー処理削除可
error1:
sh1.Range("B" & i) = "見つからず"
wb2.Activate
sh2.Select
GoTo nt2
'--
nt1:
End Sub
'http://excel-ubara.com/excelvba4/EXCEL207.html
'http://atamoco.boy.jp/vba/lang/error/on-error-resume-next.php
’－－
テストデータ（元データ）は
VLOOKUPVBAというブックのＳｈｅｅｔ１
A1:B８（１行目見出し行）
氏名 点数
吉田 45
池田 65
佐藤 54
福田 48
三木 56
野田 64
岡田 78
ーー
実行前
指定氏名のあるシート
ＶＬＯＯＫＵＰＶＢＡブックのＳｈｅｅｔ１
氏名　点数（点数を引く前でブランク）
野田
三木
佐藤
池下
池田
佐藤
木村
吉田
ーーー
実行後（点数が入った）
氏名 点数
野田 64
三木 56
佐藤 54
池下 なし
池田 65
佐藤 54
木村 なし
吉田 45
ーーー
コード
VLOOKUPVBAブックの標準モジュール
Sub test06()
On Error Resume Next
'--点数をセットするブック・シート
Set wb1 = Workbooks("VLOOKUPVBA")
Set sh1 = wb1.Sheets("Sheet1")
'--点数を採ってくるブック・シート　を開く
Set wb2 = Workbooks.Open("C:\Users\xxxx\Documents\点数例１.xlsx")
Set sh2 = wb2.Sheets("Sheet1")
'－－点数をセットするシートのA列の最下行を探る
rl = sh1.Range("A1000").End(xlUp).Row
'--探索開始
For i = 2 To rl
'点数を採ってくる氏名セルごと繰り返し
st = Application.WorksheetFunction.VLookup(sh1.Range("A" & i), sh2.Range("A2:B8"), 2, False)
If Err Then
sh1.Range("B" & i) = "なし"
Err.Clear　’ここで不案内で、手こずった
GoTo nt2
Else

'点数をセットするブック・シートのセルに点数をセット
sh1.Range("B" & i) = st
MsgBox "探索= " & sh1.Range("A" & i) & "　点数= " & st
End If
nt2:
Next i
GoTo nt1
'--エラー処理（不要、失敗例）
error1:
sh1.Range("B" & i) = "見つからず"
wb2.Activate
sh2.Select
GoTo nt2
'--
nt1:
End Sub
以下のサイトを参考にしてください
'http://excel-ubara.com/excelvba4/EXCEL207.html
'http://atamoco.boy.jp/vba/lang/error/on-error-resume-next.php
ーー
Ｇｏｏｇｌｅででも通常のケースなどはたくさんコード例がある。
それぐらいやってから質問しているのかな。
そこでやってみてどこで行き詰まったか、書くこと。
私なら、文章で質問文に
（１）引くデータが他ブックにあるときの参照ＶＢＡコード
（２）見つからないエラーが起こった時の続行
になるかな。
＞データーが50行ぐらいあるのですが。 これも書く必要ない。少数です、でよい。
ーー
普通の関数だけでも、式の複写を用いて、できると思う。
Ｇｏｏｇｌｅででも、「エクセル　関数　他ブック参照」で検索すればたくさん記事がある。
そういう時に、質問者はなぜＶＢＡでやるのか。

お礼

いろんな詳細説明ありがとうございます。

回答No.1

real beatin（@realbeatin）

こんにちは。

問題解決の為に必要な情報が不足しているので、
こちらで想定した仮の条件で一例としてお応えします。
回答する側が迷うことなくすっきりした解決を提示出来るようにする為に
必要なポイントは以下。
●マクロを書くのは「どの」ブック　？
●ブックAやブックBは開いている状態から処理するのか　？
　「何が」開いていて「何が」閉じているのか　？
　▲閉じているブックがある場合は、
　　閉じているブックのフォルダパスが必要
●「VLOOKUP」関数を使った数式を設定したい、のか、
　「VLOOKUP」で得られるのと同じ結果になるようにＶＢＡを組みたいのか　？
　▲結果として残したいのは"数式"なのか"固定値"なのか　？

こちらで想定した仮の条件
■マクロを書くのは　　ブックB
■ブックAが開いている状況からマクロを実行する前提　だけど、
　▲開いていなくても動作するように書きました。
■「VLOOKUP関数を使う例」という趣旨で書いています。
　▲"固定値"がお望みの場合は、☆の行の先頭 ' を一文字削除してください。

また、
　シート名など、各種　名前について、
　セル範囲の位置関係について、
変動する場合の指定（確認）箇所を★印でマークしていますので、
そちらで適宜修正を加えて、応用するようにしてください。

こちらで想定した仮の条件が、お望みと一致する確率は1/10未満と見ています。
必要なパーツを示すことはできていると思うので、
期待通りでなかった場合でも、まずは自分なりに応用することに努めてください。
その上で、どうしても解決できない場合は、上述のポイントを整理して、
補足欄に追加説明を書いてみて下さい。
迷わず着手できるだけの情報が揃えば、再レスするつもりです。

強調しておきますが、以下の例は、
ブックBにマクロを記載する場合、です。

' ' ///
' ' /// ブックB に記載するマクロ　２個 ///

Sub Re8984933w()
　　Dim sRefSrc As String

' ' ブックA
On Error GoTo errH_　'　ブックA が開いていない場合のエラートラップ
　　' ' 要確認★ブック名 "ブックA.xlsm" ?　拡張子を確認して正確に！★シート名 "Sheet1" ?
　　With Workbooks("ブックA.xlsm").Sheets("Sheet1")
On Error GoTo 0　'　エラートラップ解除
　　　　' ' 要確認★先頭列番地(３ヶ所) A ?★[年齢]列までの列数 .Resize(, 3) ?
　　　　sRefSrc = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Resize(, 3).Address(True, True, xlA1, True)
　　End With

' ' ブックB
　　With ThisWorkbook.Sheets("Sheet1")　'　要確認★ブックB:処理結果を反映させたいシート名 "Sheet1" ?
　　　　' ' 要確認★先頭列番地(３ヶ所) A ?★[年齢]列までの相対列位置 .Offset(, 2) ?
　　　　With .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Offset(, 2)
　　　　　　' ' 要確認★ブックB:先頭列番地 A ?★ブックA:[年齢]列までの列数 ,3 ?
　　　　　　.Formula = "=VLOOKUP(A2," & sRefSrc & ",3,0)"
　　　　　　' ' 数式の結果を値として残す場合は直下の行を　イキ
'　　　　　　.Value = .Value　'　☆
　　　　End With
　　End With

Exit Sub
errH_:
　　OpenBookA
　　Resume
End Sub

Private Sub OpenBookA()
　　' ' 要指定★ブックAのフォルダパス　例示は「このブックのフォルダパス + \」　末尾の \ を忘れずに！
　　' ' 要確認★ブックAのブック名 "ブックA.xlsm" ?　拡張子を確認して正確に！
　　Workbooks.Open ThisWorkbook.Path & "\ブックA.xlsm"
End Sub

' ' ///

お礼

有難うございます。非常に助かりました。