Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


932 / 13644 ツリー ←次へ | 前へ→

【77432】VBAで別ブックから反映について 15/10/1(木) 23:03 質問[未読]
【77433】Re:VBAで別ブックから反映について β 15/10/2(金) 0:17 発言[未読]
【77440】Re:VBAで別ブックから反映について 15/10/5(月) 14:07 質問[未読]
【77441】Re:VBAで別ブックから反映について β 15/10/6(火) 6:41 発言[未読]
【77442】Re:VBAで別ブックから反映について 15/10/6(火) 12:36 お礼[未読]

【77432】VBAで別ブックから反映について
質問    - 15/10/1(木) 23:03 -

引用なし
パスワード
   教えてください!

別ブックにある内容をVBAを使用し、
反映したいのですが方法が分かりません。

具体的には、
ブックAの
A列に"商品コード"、
B列に"商品名"、
C列に"備考"があります。
そしてブックBには、
A列に"商品コード"、
B列に"商品名"、
F列に"備考"、
があるので、
ブックAの商品コードにある備考(C列)を、
ブックBから同じ商品コードを探して、 そのF列に反映
していきたいのですが上手くいきません。


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

どなたかお助け下さい!!

【77433】Re:VBAで別ブックから反映について
発言  β  - 15/10/2(金) 0:17 -

引用なし
パスワード
   ▼馬 さん:

ブックの構成が不明ですが、
ブックA.xlsx と ブックB.xlsx があり、それとは別にマクロブックがあるというコードです。
実行時には、ブックAもブックBも、あらかじめ開かれているということが前提。
もちろん、マクロ内で、この2つのブックを自動的に開いて処理することもできますが、
まずは、あらかじめ、ひらかれているということで。

マクロブックの標準モジュールに。
★印のところは、実際のものに直してください。

Sub Test()
  Dim shA As Worksheet
  Dim shB As Worksheet
  
  Set shA = Workbooks("ブックA.xlsx").Sheets("Sheet1")  '★
  Set shB = Workbooks("ブックB.xlsx").Sheets("Sheet1")  '★
  
  With shB.Range("A2", shB.Range("A" & Rows.Count).End(xlUp)).Offset(, 5)
    .Formula = "=IFERROR(VLOOKUP(A2," & shA.Range("A1").CurrentRegion.Address(External:=True) & ",3,FALSE),"""")"
    .Value = .Value
  End With
  
End Sub

【77440】Re:VBAで別ブックから反映について
質問    - 15/10/5(月) 14:07 -

引用なし
パスワード
   β様

お返事遅くなり申し訳ございません。

ご回答ありがとうございます。


上記コードでは、ブックAに商品コードがなくて、
ブックBにある場合、ブックBの備考が消えてしまいます。
(VLOOKUPでエラーを空白にする処理そされてるからだと
思いますが・・・)

そうではなく、ブックAに商品コードがある場合、ブックBの備考に
貼り付け、
それ以外(ブックBにはあるが、ブックAにない場合)の備考は
何も変更したくないのですが、
それは可能でしょうか??

【77441】Re:VBAで別ブックから反映について
発言  β  - 15/10/6(火) 6:41 -

引用なし
パスワード
   ▼馬 さん:

それでは以下で。

Sub Test2()
  Dim shA As Worksheet
  Dim shB As Worksheet
  Dim dic As Object
  Dim c As Range
  
  Set shA = Workbooks("ブックA.xlsx").Sheets("Sheet1")  '★
  Set shB = Workbooks("ブックB.xlsx").Sheets("Sheet1")  '★
  Set dic = CreateObject("Scripting.Dictionary")
  
  For Each c In shA.Range("A2", shA.Range("A" & Rows.Count).End(xlUp))
    dic(c.Value) = c.EntireRow.Range("C1").Value
  Next
  
  For Each c In shB.Range("A2", shB.Range("A" & Rows.Count).End(xlUp))
    If dic.exists(c.Value) Then c.EntireRow.Range("F1").Value = dic(c.Value)
  Next
  
End Sub

【77442】Re:VBAで別ブックから反映について
お礼    - 15/10/6(火) 12:36 -

引用なし
パスワード
   ありがとうございます!
完璧でした!

932 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free