[[20150930183250]]　『マクロでVLOOK(別ブック参照)について』（お馬ちゃん）　ページの最後に飛ぶ

『マクロでVLOOK(別ブック参照)について』（お馬ちゃん）

こんにちは。
マクロのコードについて教えて下さい。

別ブックにある内容をマクロでvlookupを使用し、
参照したいのですが上手くいきません。

具体的には、
ブックAの
A列に"商品コード"、
B列に"商品名"、
C列に"備考"があります。

そしてブックBには、
A列に"商品コード"、
B列に"商品名"、
F列に"備考"、
があるので、
ブックAで入力された備考を、ブックBのF列にvlookupを用いて、
更新していきたいのですが上手くいきません。

下記のコードを用いてみたのですが、
ブックAにある行数分と同じ行数分しか検索されず、
またその行数に該当コードがなければエラーになります。
(↑少しわかりにくいですが、ブックAに8列しかなければ、
ブックBでは上から8列までしか検索してないようです)

※ブックAはブックBを元に作成してるので、
必ず合致するコードはあります。

コードに間違いがあると思うのですが、
これ以上分からないので、どなたかお助け下さい！！

Option Explicit
Sub デモ()
　Application.ScreenUpdating = False
　Dim I As Long
　Dim xlBook
　Set xlBook = Workbooks.Open("C:\★★.xls") 'パス名とブック名入れる予定です
　I = 2
　Do While Range("A" & I).Value <> ""
　　ThisWorkbook.Worksheets("Sheet1").Range("F" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("A" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:C70000"), 3, 0)
　　I = I + 1
　Loop
　xlBook.Close
　Application.ScreenUpdating = True
　MsgBox ("置換え完了")
End Sub

＜使用 Excel：Excel2013、使用 OS：Windows7 ＞

 >>ブックAにある行数分と同じ行数分しか検索されず、

 ブックを開きますよね。
 そうするとアクティブブックは、当然開いたブックになります。
 で、アクティブシートも、もちろん、その開いたブックで、【たまたま】アクティブだったシートになりますね。

 一方、Do While Range("A" & I).Value 　どのブックのどのシートのセルなのか明示がないので
 アクティブブックのアクティブシートのセルだとみなされますね。
 なので、（仮にそれが　開いたブックの Sheet1 だったとすれば）開いたブックのA列の最終データセルまでしか
 処理が行われませんね。

 Do While ThisWorkbook.Worksheets("Sheet1").Range("A" & I).Value <> "" でしょうね。

 ところで、このコード、Do/Loop より For/Next が適していると思いますし、スッキリもします。
 また、A2:C70000　も、実際に値のある領域のみの指定もできますし、そうすべきだと思います。

 また、ループをなくし、領域全体に１発で数式を入れて値変換ということもできます。

 それと MsgBox ("置換え完了") 【たまたま】エラーにはならず、メッセージも表示されますが、ほんとは【間違った】構文です。

 MsgBox "置換え完了" が正しい構文です。　( ) は、なくしましょう。

（β） 2015/09/30(水) 19:23

β様

お返事遅れて申し訳ございません！
ありがとうございます！
for next構文は使った事がないので
調べてみます！
本当に勉強になります！

もし良ければ追加で教えていただきたいのですが、
上記で教えていただいた構文でできたのですが、
ただ少し問題がありまして、
ブックAに記載ない番号がブックBで全てエラー表示になるので、
ブックAにある商品コードだけ
vlookを適用したいのですが、
それは可能でしょうか？

vlookでの方法から考え直した方がいいでしょうか？？
（お馬ちゃん） 2015/10/01(木) 10:58

 Application.VLookUp では、エラーの場合、エラー値が返りますので、直接セルにセットせず
 Variant型の変数で受けて、IsError等で判定して、転記するかどうかの処理をしてもいいと思いますが
 本件なら、まずセットした後、エラー値のみをクリアするほうがスムーズかもしれません。

 以下はその方式で。
 デモ2 が For/Next、デモ3 が For Each、デモ4は　ループなしで数式を埋め込み、値変換するパターンです。

 Sub デモ2()
    Dim I As Long
    Dim xlBook As Workbook
    Dim shF As Worksheet
    Dim shT As Worksheet
    Dim z As Long

    Application.ScreenUpdating = False
    Set xlBook = Workbooks.Open("C:\★★.xls") 'パス名とブック名入れる予定です
    Set shF = xlBook.Sheets("Sheet1")
    Set shT = ThisWorkbook.Sheets("Sheet1")

    z = shT.Range("A" & Rows.Count).End(xlUp).Row
    For I = 2 To z
        shT.Range("F" & I).Value = Application.VLookup(shT.Range("A" & I).Value, shF.Range("A2:C" & shF.Range("A" & Rows.Count).End(xlUp).Row), 3, 0)
    Next

    On Error Resume Next
    shT.Range("F2:F" & z).SpecialCells(xlCellTypeConstants, xlErrors).ClearContents
    On Error GoTo 0

    xlBook.Close
    Application.ScreenUpdating = True
    MsgBox "置換え完了"

 End Sub

 Sub デモ3()
    Dim xlBook As Workbook
    Dim shF As Worksheet
    Dim shT As Worksheet
    Dim c As Range
    Dim r As Range

    Application.ScreenUpdating = False
    Set xlBook = Workbooks.Open("C:\★★.xls") 'パス名とブック名入れる予定です
    Set shF = xlBook.Sheets("Sheet1")
    Set shT = ThisWorkbook.Sheets("Sheet1")
    Set r = shF.Range("A2", shF.Range("A" & Rows.Count).End(xlUp)).Resize(, 3)

    With shT.Range("A2", shT.Range("A" & Rows.Count).End(xlUp))
        For Each c In .Cells
            c.Offset(, 5).Value = Application.VLookup(c, r, 3, 0)
        Next
        On Error Resume Next
        .Cells.Offset(, 5).SpecialCells(xlCellTypeConstants, xlErrors).ClearContents
        On Error GoTo 0
    End With

    xlBook.Close
    Application.ScreenUpdating = True
    MsgBox "置換え完了"

 End Sub

 Sub デモ4()
    Dim xlBook As Workbook
    Dim shF As Worksheet
    Dim shT As Worksheet
    Dim r As Range

    Application.ScreenUpdating = False
    Set xlBook = Workbooks.Open("C:\★★.xls") 'パス名とブック名入れる予定です
    Set shF = xlBook.Sheets("Sheet1")
    Set shT = ThisWorkbook.Sheets("Sheet1")
    Set r = shF.Range("A2", shF.Range("A" & Rows.Count).End(xlUp)).Resize(, 3)

    With shT.Range("A2", shT.Range("A" & Rows.Count).End(xlUp)).Offset(, 5)
        .Formula = "=VLOOKUP(A2," & r.Address(External:=True) & ",3,0)"
        .Value = .Value
        On Error Resume Next
        .Cells.SpecialCells(xlCellTypeConstants, xlErrors).ClearContents
        On Error GoTo 0
    End With

    xlBook.Close
    Application.ScreenUpdating = True
    MsgBox "置換え完了"

 End Sub

（β） 2015/10/01(木) 13:02

β様

たくさんコードを教えていただき、ありがとうございます！
本当にすごいですね！！

ただもう一つお伺いしたいのですが、
エラーの値をクリアすると、
ブックAには商品コードはないけど、
ブックBに元々入っていたデータがクリアになるので、
ブックAに商品コードがあり、ブックBにも商品コードがあるものだけ、
反映させたいのですが、
その場合、どうなるのでしょうか？
vlookでの処理は難しいでしょうか？
（お馬ちゃん） 2015/10/01(木) 14:11

コメント返信：

[ 一覧(最新更新順) ]

[[20150930183250]] 『マクロでVLOOK(別ブック参照)について』（お馬ちゃん） ページの最後に飛ぶ

[[20150930183250]]　『マクロでVLOOK(別ブック参照)について』（お馬ちゃん）　ページの最後に飛ぶ