社会人&学生におすすめする色彩検定の勉強術

Sheet1.xlsm A列のコードを参考にリスト.xlsxからVlookupで値を検索して
Sheet1のG列、H列、I列、K列、L列、M列に値を貼り付けたいです。(J列には別のデータが入りますので空白です)

マクロは全くの初心者なのですが、仕事で指示を受け困っています。
参考書片手に試行錯誤してG4への貼り付けができるように下記のようにつくってみましたが、うまく動きません。

初歩的な内容で大変申し訳ないのですが、ご教示いただけますでしょうか?

<補足>
・Sheet1へは100件程度貼り付けたいコードが入っています。
・リスト内データは1000件あります。

Option Explicit
Sub データ転記()
Application.ScreenUpdating = False
Dim I As Long
Dim xlBook
Set xlBook = Workbooks.Open("C:\Users\wwsd111\Documents\リスト.xlsx")
I = 2
Do While Range("A" & I).Value <> ""
ThisWorkbook.Worksheets("Sheet1").Range("G" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("C:\Users\wwsd111\Documents\リスト.xlsx").Range("B" & I).Value, xlBook.Worksheets("C:\Users\wwsd111\Documents\リスト.xlsx").Range("A7:G1000"), 2, 0)
I = I + 1
Loop
xlBook.Close
Application.ScreenUpdating = True
MsgBox ("完了")
End Sub

「VBAで別のブックの値をVlookup関」の質問画像
教えて!goo グレード

A 回答 (2件)

No.1です。



>Sheet1の4行目以降にリストから抽出したデータを入力することができるか・・・
前回のコードは2行目からのループにしていました。
始まりは4行目からなのですね。
おそらく空白セルを参照してしまい、最初の空白行が表示されたのではないかと思います。

そして、もう一度コードを拝見するとG列に表示するのはVLOOKUP関数の
検索値 → 「Sheet1」のB列
範囲  → 開いたブックのA~G列の2列目すなわちB列(完全一致)
となっていますね。

画像が小さすぎて詳細が判らないのですが、
「Sheet1」のB列には何も入っていないように見えます。
そのため前回のコードはA列を検索値としていました。

もう一つ質問文に
>Sheet1のG列、H列、I列、K列、L列、M列に値を貼り付けたいです
とありますが、
開いたブック(Sheet)のどの列を当てはめれば良いのでしょうか?
その辺が判りませんので、とりあえずG列以降に表示するのは開いたSheetのB列~G列の順にしています。
↓のコードに変更してみてください。

Sub Sample2()
Dim i As Long, c As Range, wB As Workbook, wS As Worksheet
Dim myPath As String, fN As String
myPath = "C:\Users\wwsd111\Documents" & "\"
fN = "リスト.xlsx"
Application.ScreenUpdating = False
Workbooks.Open myPath & fN
Set wB = ActiveWorkbook
Set wS = wB.Worksheets(1)
With ThisWorkbook.Worksheets("Sheet1")
For i = 4 To .Cells(Rows.Count, "B").End(xlUp).Row '//4行目~B列最終行まで★//
If .Cells(i, "B") <> "" Then '//←追加//
Set c = wS.Range("B:B").Find(what:=.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole) '//★//
If Not c Is Nothing Then
.Cells(i, "G") = wS.Cells(c.Row, "B") '//★//
.Cells(i, "H") = wS.Cells(c.Row, "C") '//?//
.Cells(i, "I") = wS.Cells(c.Row, "D") '//?//
.Cells(i, "K") = wS.Cells(c.Row, "E") '//?//
.Cells(i, "L") = wS.Cells(c.Row, "F") '//?//
.Cells(i, "M") = wS.Cells(c.Row, "G") '//?//
End If
End If
Next i
End With
Application.DisplayAlerts = False
wB.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "完了"
End Sub

※ コード内の「?」の行は元データのどの列を代入していいのかわからないので
勝手に列番号を決めています。m(_ _)m
    • good
    • 1

こんにちは!



開いたブックのSheetのG・H・I・K・L・M列のデータを一致する行の同じ列に表示すれば良いのですね?
一例です。

Sub Sample1()
Dim i As Long, c As Range, wB As Workbook, wS As Worksheet
Dim myPath As String, fN As String
myPath = "C:\Users\wwsd111\Documents" & "\"
fN = "リスト.xlsx"
Application.ScreenUpdating = False
Workbooks.Open myPath & fN
Set wB = ActiveWorkbook
Set wS = wB.Worksheets(1)
With ThisWorkbook.Worksheets("Sheet1")
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
Set c = wS.Range("A:A").Find(what:=.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
.Cells(i, "G") = wS.Cells(c.Row, "G")
.Cells(i, "I") = wS.Cells(c.Row, "I")
.Cells(i, "K") = wS.Cells(c.Row, "K")
.Cells(i, "L") = wS.Cells(c.Row, "L")
.Cells(i, "M") = wS.Cells(c.Row, "M")
End If
Next i
End With
Application.DisplayAlerts = False
wB.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "完了"
End Sub

こんな感じで良いのでしょうか?m(_ _)m
    • good
    • 0
この回答へのお礼

ありがとうございます!
初歩的な内容に親切にご回答いただけてとても嬉しいです。

早速ためしてみたのですが、実行したところ、予想と違う結果になりました。

・Shee1のF2~M2までのデータが消えた
・G2に「登録日」というもともとM2に入力されていた単語が入った
・G列G4~G9までに11~16までの数字が入った

たびたび申し訳ないのですが、コードのどちらを修正しましたら、
Sheet1の4行目以降にリストから抽出したデータを入力することができるか
再度ご教示いただけますでしょうか?

よろしくお願いいたします。

お礼日時:2017/11/10 15:45

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

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

教えて!goo グレード

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング