VBA 別のブックAを参照して別のブックBへ書き込み

Question

問題
全国に店舗がある「フルーツVBA店」で注文リストに記載されている果物が入荷されているか確認したい。
注文リストを参照して入荷リストを確認し、入荷していれば〇を付けたい。

目的
①vbaファイル、注文リスト（ブックA）、入荷リスト（ブックB）の3ファイルを使用
vbaを実行すると注文リストを参照して入荷リストに書き込みしたい。

疑問点
ブックAを参照してブックBの内容を変更（〇を表示）できるか教えて欲しいです。

vbaの希望内容
vbaを実行するとよくあるファイルを開くウィンドウが表示され
参照するリストと確認したい入荷リストをユーザーがファイル選択できるようにしたい。

ファイルイメージ例
ツールの流れ
vba→ブックA参照→ブックBへ書き込み

ファイルの内容例
ブックA（注文リスト）

列1	列2
No.	果物
1	りんご
2	みかん
3	すいか

VBA実行後のブックB（入荷リスト）

列1	列2	列3
No.	果物	入荷済み
1	ばなな
2	みかん	〇
3	ぶどう

知識が浅く読みずらい内容かもしれませんが、お願いいたします。
分かりずらい点等ございましたらズバズバとご指摘ください。出来る限り修正致します。

Comments

[DreamTheater]

VBAファイルとは何ですか？

[Yuukiy]

VBAだけが記載されたファイルという意味でただのExcelです。

[tatsu99]

「参照するリストと確認したい入荷リストをユーザーがファイル選択できるようにしたい」ということですが、参照するリスト及び入荷リストがそれぞれ複数存在するということですか。
参照するリストと確認したい入荷リストがそれぞれ１ファイルなら、ファイル名を決め打ちして、読み込んだほうが楽です。

[Yuukiy]

参照するリストと入荷リストはそれぞれ複数存在するので、「参照ファイル」と「入荷リスト」のファイルをユーザーが選べるようにしたいと考えています。

[tatsu99]

ブックA（注文リスト）のシート名はなんですか。
ブックB（入荷リスト）のシート名はなんですか。

Answer 1

OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?", Title:="ブックAを選択")

If OpenFileName <> "False" Then
    Workbooks.Open OpenFileName
    Set sht1 = Workbooks(OpenFileName).Worksheets("注文リスト")
End If


OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?", Title:="ブックBを選択")
If OpenFileName <> "False" Then
    Workbooks.Open OpenFileName
    Set sht2 = Workbooks(OpenFileName).Worksheets("入荷リスト")
End If


With sht1
    For i = 2 To 4
        If .Cells(i, 2) = "★指定する果物★" Then
            For j = 2 To 4
                If sht2.Cells(j, 2) = .Cells(i, 2) Then
                    sht2.Cells(j, 3).Value = "○"
                    Exit For
                End If
            Next j
        End If
    Next i
End With

Comments

[Yuukiy]

回答ありがとうございます。参考にして実施してみます！

[Ayalla]

よろしくお願いいたします。
※変数が宣言されていないため、Option Explicitを削除してから実行したほうがいいかもしれません.

Answer 2

他ブック(ブックA)を参照して他ブック(ブックB)に書き込めます。
(できるかどうか、との質問なので「できる」とだけ答えればいいのですよね?)
(探して見つかるかどうかわからず、見つかることを保証してもらいたいのですよね?)
他ブックは(フルパス/相対パス+)excelファイル名+シート名(+セル)を指定します。相対パスでもいいけれど、フルパス指定をすすめます。
詳細はネットで検索してみてください。必ず見つかります。

Comments

[Yuukiy]

回答ありがとうございます。出来ることが分かったのでなんとかなると思います。

Answer 3

質問が大雑把ですね。
しかも所謂「丸投げ」質問です。

ブックAを参照してブックBの内容を変更（〇を表示）できるか教えて欲しいです。

できますよ。
でもこの質問は以下全てを含んでます。わからないところをもっと明確にしましょう。
・ブックの開き方
・データの取得・設定方法
・ブックの閉じ方

vbaを実行するとよくあるファイルを開くウィンドウが表示され

参照するリストと確認したい入荷リストをユーザーがファイル選択できるようにしたい。

「よくある」とは一般的なって意味ですか？
それとも利用者がよく使用するファイルという意味でしょうか？

全部わからないのでしたら、こちらの有名なサイトは初心者の方にも分かりやすく書かれています。
VBAの基礎レベルを学習して、自分なりのVBAコードが掲載できるようになった上で質問しましょう。

Comments

[Yuukiy]

ご指摘ありがとうございます。言い訳になりますが、会社から明日までにvbaを作れと言われ、出来ないと回答したのですがやれと。知識０スタートで、調べてみても分からなかったので最終手段でここで質問しました。教えていただいたサイトで出来るところまで頑張ってみます。

Answer 4

こんにちはこんばんは。ちょうど似たようなプログラムを作っていたので、こちらを参考になさってください。
こちらでテストしましたが、このままで動作します。

Option Explicit

Private Sub UpdateNyukaListByChumonList()
'注文リストにある商品名をみて、合致する商品名が入荷リストにあるとき、入荷リスト側にて”入荷済み”のカラムに〇をつける（アップデートする）プログラムです

On Error GoTo ErrorHandler  'なにかのエラーが起きたら、ErrorHandlerにジャンプします

'---注文リストについての各種の定義
Dim MyChumonListFiles As Variant    '注文リストのファイル名（複数あり）
Dim MyChumonListFileName As String   '処理対象の注文リストのファイル名（１ファイル）
Dim MyChumonListBook As Workbook  '"注文リスト"ワークブック（１ファイル）
Dim MyChumonList As Worksheet   '"注文リスト"ワークシート
Dim MyChumonListFileCount As Long   '注文リストのファイル数のカウント

Dim ItemNames As Variant   '注文リストのB列にある、商品名の集団。
Dim ItemName As Variant  '商品名の集団（ItemNames）のうちの一個

'---入荷リストについての各種の定義
Dim MyNyukaListFile As String   '入荷リストのファイル名
Dim MyNyukaListBook As Workbook   '"入荷リスト"ワークブック
Dim MyNyukaList As Worksheet    '"入荷リスト"ワークシート

'---検索をコントロールするための各種の定義
Dim SearchRange As Range    '入荷リスト側のどの部分（範囲）を検索するのか？の定義です
Dim ItemCell As Range   '検索してヒットしたときのセル範囲です


'---ここから処理開始です

'ファイルオープンダイアログを使って、”注文リスト”のブックを選択する
'”注文リスト”のブックは、複数ファイルあってもよいこととする
MyChumonListFiles = Application.GetOpenFilename("XLSXファイル,*.xlsx", Title:="注文リストを選択してください（複数選択が可能です）", MultiSelect:=True)

If Not IsArray(MyChumonListFiles) Then  'ファイルオープンのダイアログで　もしキャンセルボタンが押された場合
    MsgBox "注文リストの選択がキャンセルされました"
    Exit Sub    '終了させます
End If

'ファイルオープンダイアログを使って、”入荷リスト”のブックを選択する
'”入荷リスト”のブックは、１ファイルだけである
MyNyukaListFile = Application.GetOpenFilename("XLSXファイル,*.xlsx", Title:="入荷リストを選択してください", MultiSelect:=False)

If MyNyukaListFile = "" Then 'ファイルオープンのダイアログで　もしキャンセルボタンが押された場合
    MsgBox "入荷リストの選択がキャンセルされました"
    Exit Sub    '終了させます
End If

'---ここまででやっと　処理対象のファイルが全部決まりました

'入荷リストのブックを開きます
Workbooks.Open MyNyukaListFile
Set MyNyukaListBook = ActiveWorkbook    'このブックをMyNyukaListBookという名前で定義しセットします
Set MyNyukaList = MyNyukaListBook.Worksheets("sheet1") 'とりあえず、シート名はsheet1であるものとし、そのシートを処理対象の”入荷リスト”とします

MyNyukaList.Select 'この次の行のコードで　End(xlDown)　を使うため。セレクトしています

Set SearchRange = Range("B2", Range("B2").End(xlDown))  '入荷リストのB列２行目から データのある最終行までを"サーチレンジ”とします

    '注文 リストのブックを　順に開きます
    For MyChumonListFileCount = 1 To UBound(MyChumonListFiles)
        MyChumonListFileName = MyChumonListFiles(MyChumonListFileCount)
        Workbooks.Open MyChumonListFileName
        Set MyChumonListBook = ActiveWorkbook   'このブックをMyChumonListBookという名前で定義しセットします
        Set MyChumonList = MyChumonListBook.Worksheets("sheet1") 'とりあえず、シート名はsheet1であるものとし、そのシートを処理対象の”注文リスト”とします
        
        '注文リストと入荷リストがそれぞれ定まったので、ここからが本番です
        
        MyChumonList.Select    'この下のコードでEnd(xldown)を使うため、selectしています
            '注文リストのB列を、B2セルから　データがある最後のセルまで順番に一個ずつ見ていく
            Set ItemNames = MyChumonList.Range("B2", Range("B2").End(xlDown))
            
            For Each ItemName In ItemNames
                    Set ItemCell = SearchRange.Find(what:=ItemName, lookat:=xlWhole)  '商品名に合致するセルがあるかどうかを"FIND"します
                    
                    If Not ItemCell Is Nothing Then '合致するセルが見つかったら
                        ItemCell.Offset(0, 1) = "〇"  'そのセルの右隣(C列)に〇をセットする
                    End If
                    
            Next ItemName  '次のアイテム名へ移る
            
        MyChumonListBook.Close  'この注文リストファイルは済んだので閉じます
        
    Next MyChumonListFileCount '次の注文リストファイルへ

    '処理が完了したら､
    'このタイミングで、入荷リストのブックを　上書き保存しておく
        Application.DisplayAlerts = False   '上書き保存のワーニングが出ないようにする
        MyNyukaListBook.Save
        Application.DisplayAlerts = True  'ワーニングが出るように、元に戻す
        
    MsgBox "処理が完了しました"
    MyNyukaList.Cells(1, 1).Select '入荷リストのＡ１セルをアクティブにする

Exit Sub

ErrorHandler:   'なにかのエラーが発生したとき　ここにジャンプしてきます
    MsgBox "エラーが発生しました"

End Sub

Answer 5

以下のようにしてください。
注文リストのシート名と入荷リストのシート名が不明なので、"Sheet1"にしておきました。
異なる場合は、
Set sh1 = Worksheets("Sheet1")・・・注文リスト
Set sh2 = Worksheets("Sheet1")・・・入荷リスト
の個所を変えてください。

Option Explicit


Public Sub 入荷済設定()
    Dim 注文book As Variant
    Dim 入荷book As Variant
    Dim ret As Variant
    Dim 注文bk As Workbook
    Dim 入荷bk As Workbook
    Dim maxrow1 As Long
    Dim maxrow2 As Long
    Dim wrow As Long
    Dim sh1 As Worksheet    '注文リスト
    Dim sh2 As Worksheet    '入荷リスト
    Dim key As Variant
    Dim dicT As Object
    Set dicT = CreateObject("Scripting.Dictionary")
    注文book = Application.GetOpenFilename("注文ブック,*.xlsx")
    If 注文book = False Then Exit Sub
    入荷book = Application.GetOpenFilename("入荷ブック,*.xlsx")
    If 注文book = False Then Exit Sub
    ret = MsgBox("以下のファイルが選択されました。" & vbLf & "これでよろしいですか。" & vbLf & "注文ブック=" & 注文book & vbLf & "入荷ブック=" & 入荷book, vbOKCancel)
    If ret <> vbOK Then Exit Sub
    Set 注文bk = Workbooks.Open(注文book)
    Set 入荷bk = Workbooks.Open(入荷book)
    注文bk.Activate
    Set sh1 = Worksheets("Sheet1")
    maxrow1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row  'A列最大行
    For wrow = 2 To maxrow1
        key = sh1.Cells(wrow, "B").Value
        dicT(key) = True
    Next
    入荷bk.Activate
    Set sh2 = Worksheets("Sheet1")
    maxrow2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row  'A列最大行
    For wrow = 2 To maxrow2
        key = sh2.Cells(wrow, "B").Value
        If dicT.exists(key) = True Then
            sh2.Cells(wrow, "C").Value = "○"
        Else
            sh2.Cells(wrow, "C").Value = ""
        End If
    Next
    MsgBox ("設定完了")
End Sub