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

Question

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

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

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

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

やりたいことは、

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

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

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

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

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

tatsumaru77 · Accepted Answer

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

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    '最初の１件目
                        Else
                            sh.Cells(wrow, wcol).Value = sh.Cells(wrow, wcol).Value & "," & ws.Name    '２件目以降
                        End If
                    End If
                Next
            End If
        Next
        wb.Close
    Next
    MsgBox ("完了")
End Sub

tatsumaru77 · Answer

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

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

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

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

tatsumaru77 · Answer

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

ppp2122 · Answer

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

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

tatsumaru77 · Answer

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

ママチャリ · Answer

これで、どうでしょう。
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

ppp2122 · Answer

自分が理解できないものを
他人にコードを書いて貰って
後日　予期せぬ動作をしたときに
対処できるんでしょうか？

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

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

ループ処理と
Ifの判定条件を理解すれば
ほぼできると思われますが

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

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

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

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

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

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

これで、どうでしょう。

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

似たような質問が見つかりました

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

関連するカテゴリからQ&Aを探す

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

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

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