プロが教えるわが家の防犯対策術!

エクセルVBA→他ブックを参照して、条件に一致したシート名をセルに記入したい。



VBAの難しさに悶えてます。
みなさまのお知恵を貸してください。

サマリブックというエクセルブックの
"商品一覧"というシートに記入処理を行いたいのですが、
この商品一覧には600件ほどの商品名が載っています。 
このG、H、I列に、参照ブックから 
項目を比較し、
その項目がのってるシート名を入れたいです。


参照するエクセルブックは3ブックあって、(サマリブックと同じフォルダです。)
田中注文書 
高橋注文書 
佐藤注文書 
という名前のエクセルブックを順番に開いて
それぞれ複数シートある中から セルB3に『商品名』と入っているシートだけ見ます。
(3ブック全てフォーマット等は同じ)


やりたいことは、

サマリブックの商品名と商品IDのB5以降、C5以降と、
注文書の商品名と商品IDのB4以降、C4以降をみて、
【商品名と商品IDが一致】したら、
その項目が記載されてるシート名を
サマリブックのそれぞれの列に記入していきたいのです。

サマリブックの画像の通り、
田中注文書 G列
高橋注文書 H列
佐藤注文書 I列

複数のシート名が記載される場合には、カンマ , で区切って表示したいです。


マクロ動作はできるだけ軽くしたいので、
3ブック一気に開くか、順番に開くかなど、
動作速度が速くなる方法がありましたらアドバイスください。

わがまま注文で申し訳ないですが
お恥ずかしながらまだコード書きはむずかしく・・
教えていただけると幸いです。

「エクセルVBA→他ブックを参照して、条件」の質問画像

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

  • 補足: 注文書の例画像です

    「エクセルVBA→他ブックを参照して、条件」の補足画像1
      補足日時:2020/12/03 17:36

A 回答 (7件)

標準モジュールに登録してください。



Option Explicit

Public Sub サマリー()
Dim dicT As Object
Dim order_books As Variant
Dim maxrow As Long
Dim maxrow2 As Long
Dim wrow As Long
Dim wrow2 As Long
Dim wcol As Long
Dim sh As Worksheet
Dim i As Long
Dim wb As Workbook
Dim ws As Worksheet
Dim key As String
order_books = Array("田中注文書", "高橋注文書", "佐藤注文書")
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
Set sh = Worksheets("商品一覧概要")
maxrow = sh.Cells(Rows.Count, "B").End(xlUp).Row 'B列 最終行を求める
If maxrow < 5 Then Exit Sub
sh.Range(sh.Cells(5, 7), sh.Cells(maxrow, 7 + UBound(order_books))).Value = ""
'商品ID及びその行を全て記憶する
For wrow = 5 To maxrow
key = sh.Cells(wrow, "B").Value & "|" & sh.Cells(wrow, "C").Value
dicT(key) = wrow
Next
For i = 0 To UBound(order_books)
wcol = 7 + i
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & order_books(i) & ".xlsm")
For Each ws In wb.Worksheets
If ws.Cells(3, "B").Value = "商品名" Then
maxrow2 = ws.Cells(Rows.Count, "B").End(xlUp).Row '各注文シートの B列 最終行を求める
For wrow2 = 4 To maxrow2
key = ws.Cells(wrow2, "B").Value & "|" & ws.Cells(wrow2, "C").Value
If dicT.exists(key) = True Then
wrow = dicT(key)
If sh.Cells(wrow, wcol).Value = "" Then
sh.Cells(wrow, wcol).Value = ws.Name '最初の1件目
Else
sh.Cells(wrow, wcol).Value = sh.Cells(wrow, wcol).Value & "," & ws.Name '2件目以降
End If
End If
Next
End If
Next
wb.Close
Next
MsgBox ("完了")
End Sub
    • good
    • 1
この回答へのお礼

あなたに会えてよかった

あなたのようにコードがかけるようになりたいです。
連想配列の定義は初めて知りました。
参考になることばかりで感動です。
お礼が遅くなってしまい申し訳ありません。

意図をくみ取っていただき、ご親切に沿ったコードまで回答くださり、
想像以上にお優しくしてくださり何と言ったらいいか。。
勉強頑張ります。
以前もお世話になりましたが、tatsumaru77さんを
ベストアンサーとさせていただきます。
この度はありがとうございました。

お礼日時:2020/12/07 10:01

サマリブック(マクロのあるブック)のシート名は何でしょうか。


【商品名と商品IDが一致】したら、とありますが、
これは、「商品名と商品IDが共に一致」したらと解釈できます。
商品IDだけの比較ではだめなのでしょうか。
サマリブック側で
商品名 商品ID
飲料品 001211・・・①
飲料品 001212・・・②

注文書側で
商品名 商品ID
飲料品 001211・・・①
飲料品 001212・・・②
印刷品 001212・・・③

とあった場合、③は対象外としたいということでしょうか?

商品名が同じでも商品IDが異なるものがある。
商品IDが同じなら、商品名は必ず一致するはずだが、たまに
間違いで商品名か商品IDのどちらかが誤っていることがあるので、
商品名と商品IDの両方で比較したい。
ということでしょうか。
    • good
    • 1
この回答へのお礼

サマリブックのシート名は "商品一覧概要" です。

これは面倒だと思われる話なのですが、
1 飲料品     001211
2 ●●飲料品   001211

『飲料品』に『●●』と文字が入っていることがあったり
同じ商品名で商品IDがちがうことや、
そもそもが誤っていることもあります。

片方のみの一致でもいいじゃないかと思われるのですが、
今回は、
「商品名と商品IDが共に一致」している場合のみ、
どこで使われているかのシート名を知りたいです。

貴殿のおっしゃる通り、
注文書側でのその例の場合は③は対象外としたいです。

私の意図が伝われば幸いです。よろしくお願いします。

お礼日時:2020/12/04 16:34

シート名がsheet(1),sheet(2),sheet(3)のようになっていますが、


sheet1をコピーして作成したので、そのようなシート名になったのでしょうか。通常はsheet1,sheet2,sheet3等になるかと思うのですが・・・
    • good
    • 1

身になるとかいう話しではなく


目的を達成し その後困ることにならないか というお話です

業務で使うものは、走り出したら簡単には止められません
自分が困る=会社が困るんです
自身が理解できる範囲にとどめておかないと
膨大なロスに繋がります(これはマジです)
    • good
    • 1
この回答へのお礼

はい。おっしゃる通りです。
今後私がいなくなった後のメンテナンスや、
ほかに応用の組み込み含め、
回答くださった回答を
全てまるまるコピーというわけにもいかないので、
現在わたしが理解できる範囲で、参考にさせて頂こうと考えてます。


今後の業務を便利にしたいと考える以上、周りにVBAの先生もいないので、
ここで聞きたいことを聞くしかありません。
丸投げと言われれば、確かにそうかもしれませんが、さすがに続けて詰まってしまうと、お知恵を借りたくもあります。
苦手なことをやるなと言われればそれまでですが、私は身につけていきたいと考えてます。
みなさまがくださった回答で理解がはかどり、今後勉強する上でのモチベーションにもなります。


(何が言いたいかまとまらず申し訳ない。)
今回の私の言動考え方で不快に思われたのであれば、申し訳ありません。
今後についてご心配くださり、ありがとうございます。

お礼日時:2020/12/04 16:54

3ブック 田中注文書,高橋注文書,佐藤注文書の拡張子はなんでしょうか。

    • good
    • 1
この回答へのお礼

質問を見てくださりありがとうございます。
3ブックの拡張子は .xlsmです。

お礼日時:2020/12/04 10:13

これで、どうでしょう。


9割方は、要求を満たしていると思います。
もし不足があれば、コードを解析して、ご自分で修正してみて下さい。

Sub sample()
Set sh = ActiveSheet
fo = ThisWorkbook.Path & "\"
lr = sh.Cells(Rows.Count, "B").End(xlUp).Row
For Each fn In sh.Range("G4:I4")
With Workbooks.Open(Filename:=fo & Dir(fo & fn.Value & ".xls*"))
For Each ws In .Worksheets
For i = 5 To lr
If WorksheetFunction.CountIf(ws.Cells, sh.Cells(i, "B").Value) > 0 Then
If sh.Cells(i, fn.Column).Value <> "" Then sh.Cells(i, fn.Column).Value = sh.Cells(i, fn.Column).Value & ","
sh.Cells(i, fn.Column).Value = sh.Cells(i, fn.Column).Value & ws.Name
End If
Next i
Next ws
.Close
End With
Next fn
End Sub
    • good
    • 1
この回答へのお礼

助かりました

ご回答ありがとうございます。
拡張子でファイル見つけるのは思いつきませんでした。
私が考えていたコードよりもすっきりしていて、勉強あるのみだなと・・。
ありがとうございます!!
参考にさせて頂きます!!

お礼日時:2020/12/04 10:11

自分が理解できないものを


他人にコードを書いて貰って
後日 予期せぬ動作をしたときに
対処できるんでしょうか?

というお話です
基本は理解し この部分についてわからないから
教えてくれ なら後の対処はできるでしょう
しかし 丸投げはねぇ・・・

意地悪して 何か仕込まれたらどうします?

ループ処理と
Ifの判定条件を理解すれば
ほぼできると思われますが
    • good
    • 1
この回答へのお礼

これでは丸投げにも程がありましたね、ご指摘の通りです、不快に思われたかとも思います。申し訳ありません。

コードなど自分なりに書いて、添削などの形でご指摘いただく方が、身になるのでしょう・・
もう少し書き記して、再度不明点は質問させて頂きます。

お礼日時:2020/12/04 10:10

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

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


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

人気Q&Aランキング