• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:空白セルへの値反映と既存値との比較について)

Excelマクロでファイル間の値反映と比較を行う方法

このQ&Aのポイント
  • Excelマクロを使用して、複数のファイル間で特定の列の値を検索し、別の列に反映する方法について解説します。
  • また、反映する際に条件を指定して特定の値のみを反映する方法や、既存の値と比較して不一致の場合に別のシートに情報を表示する方法についても説明します。
  • この方法を使用することで、データの一元管理や自動更新ができるようになります。

質問者が選んだベストアンサー

  • ベストアンサー
  • ki-aaa
  • ベストアンサー率49% (105/213)
回答No.1

ファイルは全て同じフォルダに有るものとする。 C列とD列両方とも空白のときのみ変更する。 ファイル名は次のとおりです。 バイク部門ファイル.xls 車部門ファイル.xls 車(トラック含)部門ファイル.xls シート名は次のとおりです。 管理 バイク部門 車部門 車トラック含部門 不一致 このマクロは、管理ファイルに書いてある。 E列が「書籍」で、F列が「1」の場合、前の値と違うときは、不一致に書き出すとともに   C列とD列両方とも空白でないときも、管理を書き換えています。 管理ファイルの中で、商品番号のダブりは無いものとします。 管理ファイルにない商品番号はない!として処理しています。 違うときは、補足願います。 Sub 値の転記()   Dim 配列 As Variant   Dim 不一致(1 To 1000, 1 To 6) As Variant '不一致は1000行まで確保   Dim i As Long, j As Long, k As Long   Dim Gyo As Long   Dim myDic As Object   Set myDic = CreateObject("Scripting.Dictionary")   With ThisWorkbook.Sheets("管理")     配列 = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Resize(, 6).Value     For i = 1 To UBound(配列)       myDic.Add 配列(i, 1), i     Next   End With      On Error Resume Next     Workbooks("バイク部門ファイル.xls").Activate     If Err.Number <> 0 Then       Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "バイク部門ファイル.xls"     End If   On Error GoTo 0   With Workbooks("バイク部門ファイル.xls").Sheets("バイク部門")     For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row       j = myDic.Item(.Range("A" & i).Value)       If 配列(j, 3) = "" And 配列(j, 4) = "" Then         配列(j, 3) = .Range("C" & i).Value         配列(j, 4) = .Range("D" & i).Value       Else         If 配列(j, 3) <> .Range("C" & i).Value Or _           配列(j, 4) <> .Range("D" & i).Value Then           Gyo = Gyo + 1           不一致(Gyo, 1) = 配列(j, 1)           不一致(Gyo, 2) = 配列(j, 3)           不一致(Gyo, 3) = 配列(j, 4)           不一致(Gyo, 4) = .Range("C" & i).Value           不一致(Gyo, 5) = .Range("D" & i).Value           不一致(Gyo, 6) = "バイク部門"         End If       End If     Next i   End With 以下次の回答で

その他の回答 (2)

  • ki-aaa
  • ベストアンサー率49% (105/213)
回答No.3

続き 3   On Error Resume Next     Workbooks("車(トラック含)部門ファイル.xls").Activate     If Err.Number <> 0 Then       Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "車(トラック含)部門ファイル.xls"     End If   On Error GoTo 0   With Workbooks("車(トラック含)部門ファイル.xls").Sheets("車トラック含部門")     For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row       j = myDic.Item(.Range("A" & i).Value)       If 配列(j, 3) = "" And 配列(j, 4) = "" Then         配列(j, 3) = .Range("C" & i).Value         配列(j, 4) = .Range("D" & i).Value       Else         If 配列(j, 3) <> .Range("C" & i).Value Or _           配列(j, 4) <> .Range("D" & i).Value Then           Gyo = Gyo + 1           不一致(Gyo, 1) = 配列(j, 1)           不一致(Gyo, 2) = 配列(j, 3)           不一致(Gyo, 3) = 配列(j, 4)           不一致(Gyo, 4) = .Range("C" & i).Value           不一致(Gyo, 5) = .Range("D" & i).Value           不一致(Gyo, 6) = "トラック含"         End If         If 配列(j, 5) = "書籍" And 配列(j, 6) = 1 Then           配列(j, 3) = .Range("C" & i).Value           配列(j, 4) = .Range("D" & i).Value         End If       End If     Next i   End With   With ThisWorkbook     .Sheets("管理").Range("A2", .Sheets("管理").Range("A" & Rows.Count).End(xlUp)).Resize(, 6).Value = 配列     .Sheets("不一致").Range("A2:F1001").ClearContents     .Sheets("不一致").Range("A2", .Sheets("不一致").Range("F" & Gyo + 1)).Value = 不一致   End With      Set myDic = Nothing End Sub

goozy838
質問者

補足

ki-aaa様 ご教示いただきありがとう御座いました。 無事、実施したい事ができました。本当に感謝致します。 ご質問させていただきたいのですが、「管理シート」の「棚番号」と「棚段数」の列を移動したくて、下記のマクロの部分で、移動先の列番号に変更しました。 しかし、「棚番号」の列には反映されましたが、「棚段数」の列は全く反映されず空白のままになります。。 ※「棚番号」は、5列目(E列)へ移動し、「棚段数」は、8列目(H列)へ移動したい。 ※下記マクロの箇所が3回続くので、全て列番号は変更しました。 If 配列(j, 5) = "" And 配列(j, 8) = "" Then 配列(j, 5) = .Range("C" & i).Value 配列(j, 8) = .Range("D" & i).Value Else If 配列(j, 5) <> .Range("C" & i).Value Or _ 配列(j, 8) <> .Range("D" & i).Value Then Gyo = Gyo + 1 不一致(Gyo, 1) = 配列(j, 1) 不一致(Gyo, 2) = 配列(j, 5) 不一致(Gyo, 3) = 配列(j, 5) 不一致(Gyo, 4) = .Range("C" & i).Value 不一致(Gyo, 5) = .Range("D" & i).Value 不一致(Gyo, 6) = "バイク部門" End If 他の部署の依頼により今後も「棚番号」と「棚段数」の列を移動させる可能性がございます。 恐れ入りますが、移動させる場合のマクロの変更箇所と変更した箇所のマクロの意味をお教え頂けないでしょうか。 御手数おかけしており大変恐縮ですが、何卒、宜しくお願い致します。

  • ki-aaa
  • ベストアンサー率49% (105/213)
回答No.2

続き 2   On Error Resume Next     Workbooks("車部門ファイル.xls").Activate     If Err.Number <> 0 Then       Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "車部門ファイル.xls"     End If   On Error GoTo 0   With Workbooks("車部門ファイル.xls").Sheets("車部門")     For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row       j = myDic.Item(.Range("A" & i).Value)       If 配列(j, 3) = "" And 配列(j, 4) = "" Then         配列(j, 3) = .Range("C" & i).Value         配列(j, 4) = .Range("D" & i).Value       Else         If 配列(j, 3) <> .Range("C" & i).Value Or _           配列(j, 4) <> .Range("D" & i).Value Then           Gyo = Gyo + 1           不一致(Gyo, 1) = 配列(j, 1)           不一致(Gyo, 2) = 配列(j, 3)           不一致(Gyo, 3) = 配列(j, 4)           不一致(Gyo, 4) = .Range("C" & i).Value           不一致(Gyo, 5) = .Range("D" & i).Value           不一致(Gyo, 6) = "車部門"         End If       End If     Next i   End With

goozy838
質問者

お礼

ki-aaa様 ご教授いただきありがとう御座いました。 不明点が多く戸惑ってばかりですが、 もっとマクロを勉強するように致します。 御手数おかけしました。

関連するQ&A