二つのシートで同一IDのものをまとめる方法2
エクセルで作成された二つの製品表を一つにする作業にてこずっています。
製品表は二つともAカラムにIDがあります。
製品表１には、同一のＩＤが二つ以上存在しません。
製品表２には、同一のＩＤが１～３存在します。
製品表１は
000128｜product1
0KV502|product2
のように並んでいます。
製品表２は、
A ｜ B ｜C
000128 ｜ UNIT | UNIT NO.
000128 ｜ BOX | BOX NO.
000128 ｜ PALLET | PLT NO.
0KV502 | UNIT | UNIT NO.
0KV502 | PALLET |
のように、同一ＩＤに対し、Unit番号、Box番号、Plt番号が異なる段に並んでいます。
IDは必ず入力されていますが、Unit番号、Box番号、Plt番号は必ずしも入力されているとは限りません。
また同一IDに対し、2列しかない場合や1段しかない場合もあります。
また、製品表１にあり、製品表２にないＩＤもあります。
この製品表２にある、Unit番号、Box番号、Plt番号を下の図のように、製品表１にコピーしたいです。
000128｜ product1 | Unit No | Box no | Plt No
0KV502 | product2 | Unit No | Box no | Plt No
製品表１のIDを変数「ID1」に格納し、
Dim ID1, ID2, Code, EAN, VL, PU As String
Dim row1, row2, c1, c2 As Integer 'row1,c1が製品表１のループに使い、row2、c2を製品表２のループに使います。
Dim qty, weight, PP As String '本当はUnit番号、Box番号、Plt番号以外にも数量や重量などのデータもコピーします。同じ段にあるので、その点はすでに解決済みです。
Sub my_merge()
row1 = 6 '製品表1のデータは6段目から始まります。
Worksheets("Items").Activate '製品表１の名前はItemsです。
Do Until row1 = 10'本当は8000列ありますが、デバグしやすいように最初の10段だけ比較しています。
ID1 = Cells(row1, 1).Value '製品表１のデータを格納しています。
row2 = 3 '製品表２は3段目から始まります。
Do Until row2 = 20'本当は12000段ありますが、デバグしやすいように最初の20段だけ比較しています。
Worksheets("uom").Activate'uomが製品表２です。
ID2 = Cells(row2, 1).Value'uomにあるIDを格納します。
If ID2 = ID1 Then'IDが一致したら
Call my_copy'コピーします。
Else
Call my_copy_delete'違ったら、前回コピーしたものを削除します。
End If
row2 = row2 + 1
Loop
Call my_debug
row1 = row1 + 1
Loop
Worksheets("Items").Activate
End Sub
Sub my_debug()
Debug.Print "a loop-------------"
Debug.Print "row1 is " & row1
Debug.Print "row2 is " & row2
Debug.Print "ID1 is " & ID1
Debug.Print "ID2 is " & ID2
Debug.Print "Code is " & Code
Debug.Print "EAN is" & EAN
Debug.Print ActiveSheet.Name & " is active"
End Sub
Sub my_copy()
Code = Cells(row2, 2).Value 'CodeでUNITかBOXかPALLETかを判断します。
qty = Cells(row2, 3).Value '数量
EAN = Cells(row2, 4).Value 'EANはUNIT、BOX、PALLETの番号です。
VL = Cells(row2, 5).Value
weight = Cells(row2, 6).Value
PU = Cells(row2, 7).Value
PP = Cells(row2, 8).Value
End Sub
Sub my_copy_delete()
ID2 = 0
Code = 0
qty = 0
EAN = 0
VL = 0
weight = 0
PU = 0
PP = 0
End Sub
Sub my_paste_group()
'本当は、UNIT,BOX,PALLETが、それぞれ重量、質量など、IDを含んで8つデータを持っているので、それにあわせてデータを横に並べます。
If Code = "UNIT" Then '
c1 = 14
Worksheets("Items").Activate
Call my_paste
ElseIf Code = "BOX" Then
c1 = 22
Worksheets("Items").Activate
Call my_paste
ElseIf Code = "PALLET" Then
c1 = 30
Worksheets("Items").Activate
Call my_paste
Else
MsgBox "unexpected error"
Exit Sub
End If
End Sub
Sub my_paste()
Cells(row1, c1).Value = ID2
Cells(row1, c1 + 1).Value = Code
Cells(row1, c1 + 2).Value = EAN
Cells(row1, c1 + 3).Value = VL
Cells(row1, c1 + 4).Value = PU
Cells(row1, c1 + 5).Value = qty
Cells(row1, c1 + 6).Value = weight
Cells(row1, c1 + 7).Value = PP
End Sub
当方欧州住まいで、今朝から11:30まで丸一日かけたのですが、完全に煮詰まりました。
誰か助けてください。。
