エクセルで異なるファイルのA列とB列の差分を書き換え

質問

オンラインショップを運営しており、
日々変わる在庫数をエクセルで更新したいのです。
[1.csv]（日々更新される在庫数情報）と[2.csv]（ショップ上の在庫）という２つのファイルがあり、
[1.csv]上の在庫数を参照して、[2.csv]上にある古い在庫数を書き換えたいのです。

[1.csv]　　　　　　　　　[2.csv]
　　A列　　　B列　　　　　　　C列　　D列
行　型番　　　数量　　　　行　　型番　　　数量
1　12345　　　50　　　　　3　　12345　　40 (←50に書き換え)
6　12346　　　30　　　　　4　　12346　　50 (←30に書き換え)
7　12347　　　40　　　　　6　　12347　　20 (←40に書き換え)
8　12348　(←無くなる)　　9　　12348　　[着色]

1、2.csvとも型番に対する行番号は不連続で、A列にある商品が無くなったりする場合もあります。
+1）なくなった場合は色がつく
+2）在庫数の差分を[2.csv]E列に表示させる

もしくは、このような更新作業ができるアプリなどあるのでしょうか？
使用ソフトはEXEL2007です。よろしくお願いします！

回答No.1

tossy005 · ベストアンサー

1.csvと2.csvの内容がよく分かりませんが、以下のようだと想像しました。

■1.csvの内容
A列に検索のキーとなる型番がある
B列に数量がある

■2.csvの内容
C列に検索のキーとなる型番がある
D列に数量がある

■プログラムの目的
1.csvと2.csvのキー同士を照らし合わせ、1.csvの数量を2.csvの数量に反映する

もしそうなら、2.csvを開いた状態で以下のマクロをご使用下さい。
ただし、マクロの初期設定の項目を実際のシートの内容に変更してからご使用下さい。

■マクロ

Sub test()
Dim file_name As String
Dim key1_retsu As Integer
Dim key1_gyou As Integer
Dim key2_retsu As Integer
Dim key2_gyou As Integer
Dim syutoku_retsu As Integer
Dim henkou_retsu As Integer
Dim kuuhaku_cnt As Long
Dim kuuhaku_ok As Integer
Dim sheet_name1 As String
Dim sheet_name2 As String
Dim line_cnt As Long
Dim xlapp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim r As Excel.Range
Dim max_gyou As String

'*******************************************初期設定開始*******************************************
'初期設定のデータは実際のデータに合わせて値を変えて下さい

'1.csvのキーとなるデータが始まるセルの列（例題の場合型番の最初のセル(1,1)の列、つまり1）
key1_retsu = 1
'1.csvのキーとなるデータが始まるセルの行（例題の場合型番の最初のセル(1,1)の行、つまり1）
key1_gyou = 1
'2.csvのキーとなるデータが始まるセルの列（例題の場合型番の最初のセル(3,3)の列、つまり3）
key2_retsu = 3
'2.csvのキーとなるデータが始まるセルの行（例題の場合型番の最初のセル(3,3)の行、つまり3）
key2_gyou = 3
'1.csvの取得するデータのあるセルの列（例題の場合数量の列、つまり2)
syutoku_retsu = 2
'2.csvの変更するデータのあるセルの列（例題の場合数量の列、つまり2)
henkou_retsu = 4
'1.csvの該当するデータのあるシート名（例題の場合"1")
sheet_name1 = "1"
'2.csvの該当するデータのあるシート名（例題の場合"2")
sheet_name2 = "2"
'データとデータの間に何行の空白まで許容するか。データがすべて連続しているなら0でよい
kuuhaku_ok = 100
'1.csvのフルパス。ダイアロクで指定したい場合は改編してください。今回はDドライブの直下にあるとします。
file_name = "D:\1.csv"

'*******************************************初期設定終了*******************************************
Set xlapp = CreateObject("Excel.Application")
Set xlbook = xlapp.Workbooks.Open(file_name, , True)
Set xlsheet = xlbook.Worksheets(sheet_name1)
line_cnt = 0
kuuhaku_cnt = 0
With xlsheet
Do Until kuuhaku_cnt >= kuuhaku_ok
If .Cells(key1_gyou + line_cnt, key1_retsu).Value = "" Then
kuuhaku_cnt = kuuhaku_cnt + 1
Else
kuuhaku_cnt = 0
End If
line_cnt = line_cnt + 1
Loop
End With
max_gyou = line_cnt - kuuhaku_cnt

line_cnt = 0
kuuhaku_cnt = 0
With ThisWorkbook.Worksheets(sheet_name2)
Do Until kuuhaku_cnt >= kuuhaku_ok
If .Cells(key2_gyou + line_cnt, key2_retsu).Value <> "" Then
kuuhaku_cnt = 0
Set r = xlsheet.Range(xlsheet.Cells(key1_gyou, key1_retsu), xlsheet.Cells(max_gyou, key1_retsu)).Find(.Cells(key2_gyou + line_cnt, key2_retsu).Value)
If r Is Nothing Then
.Cells(key2_gyou + line_cnt, henkou_retsu).Interior.Color = RGB(192, 192, 192) '色は好きな色に変えて下さい
Else
.Cells(key2_gyou + line_cnt, henkou_retsu).Value = xlsheet.Cells(r.Row, syutoku_retsu).Value
End If
Set r = Nothing
Else
kuuhaku_cnt = kuuhaku_cnt + 1
End If
line_cnt = line_cnt + 1
Loop
End With
Set xlsheet = Nothing
xlbook.Close
Set xlbook = Nothing
xlapp.Quit
Set xlapp = Nothing
MsgBox "処理が終了しました。"

End Sub

お礼

非常に詳しい内容ありがとうございます。
さっそくテストしてみます。