二つのシートで同一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まで丸一日かけたのですが、完全に煮詰まりました。
誰か助けてください。。

回答No.1

mpro-gram · ベストアンサー

マクロは解らないけど、対応させるためのカラムを追加して、セルに式を構築していけば、Vlookup 関数でいけそうだけど。
Vlookupの参照は、先頭の１カラム対応だから、
１．まず、表２(Sheet2とする)の方に、A列手前にもう一つカラムを足して、ID+codename を作る

=CONCATENATE(B2,C2)

A列２行目に上記の式を入れたら、コピーして下方の行全部にペースト（以下の作業は皆一行作ったらそれをコピーして下方の行にペーストすると、全部すぐ計算される）
Sheet2 は、以下の列になる
A列( 式 =CONCATENATE(B2,C2) )、B列(id)、C列(codename)、D列(各番号)
ちなみに、一行目には、カラムの項目名が入ってることとして、２行目以降をデータとして説明しています。

２．Sheet2を、上記で追加したA列で並べ替えしておく

３．表１(Sheet1とする)へ戻り、各行の M,N,O列に、比較用に id+"Unit" などの文字列を作る
M列( 式 =CONCATENATE($A2,"Unit") )、N列( 式 =CONCATENATE($A2,"Box") )、O列( 式 =CONCATENATE($A2,"Pallet") )
※　コード数が４つ以上有るなら、その分を、P,Q列などにも作成しておきます。コード数増加に対応するなら、X列からとか、AA列からの方がいいかも

４．Sheet1!C列２行目にVlookup計算式を入れる、範囲指定のところは、Sheet2 の２行目以降全部が入るようにする。つまり$80のところは適宜書き換えること
=VLOOKUP(M2,Sheet2!$A$2:$D$80,4,FALSE)

同じく sheet1のD,E列同じ行に上記コピーペーストすると以下のデータが入る
D列 =VLOOKUP(N2,Sheet2!$A$2:$D$80,4,FALSE)
E列 =VLOOKUP(O2,Sheet2!$A$2:$D$80,4,FALSE)
コードの数だけ、コピーペーストで列を作ります。
※ Sheet2!D 列で、データがないと、上記計算結果は 0 が入ってしまうので、空文字列としたいなら、Sheet2!D 列で、データがないセルには、先頭に ' のみを入れて空文字列としておいて下さい

５．仕上げに、Sheet1のA列からL列まで全体をコピーして、Sheet3 または別のファイルに、「形式を選択して貼り付け」→「値」にチェックしてペースト実行
　こちらの　値だけ貼り付けた物は、元のSheet2のデータ変更が反映されないが、Sheet1 のM列以降がない表として使える
Vlookupでマッチするデータがないと、　#N/A　と表示されるが、これは、値コピーしたシートでなら、マクロで消せるだろう。

回答No.2

OrangeCup150

初歩的なことですが

Dim ID1, ID2, Code, EAN, VL, PU As String

ではなく、

Dim ID1 As String, ID2 As String, Code As String, EAN As String, VL As String, PU As String

と書きます。 ID1, ID2, Code, EAN, VL は型指定を省略したとみなされ Variant 型になります。
次に、

Dim row1, row2, c1, c2 As Integer

ではなく、

Dim row1 As Long, row2 As Long, c1 As Long, c2 As Long

と書きます。 Integer 型は -32768 から 32767 の範囲しか表現できません。つまり、 32767 行までしか処理できません。
Long 型を使用して下さい。 -2147483648 から 2147483647 の範囲を表現できるのですべての行を処理できます。
要約すると VB は Pascal ではありません。 VB の言語仕様（わりとひどい。といっても古い言語で古いＰＣ（１６ビット時代）との互換性だからしかたない）を確認して下さい。（とは言っても、公式資料も何年も修正されていない間違いがあるので注意が必要なんですが・・・。まあ、マイクロソフトが .NET を押しているからしかたないですね。 「VBA なんて使わず .NET 使ってね」な感じですからね。）

あと、用語が一般的でないのが気になりますが・・・。
一般的には row = 行 で、段ではあまり数えません。 Word の場合には paragraph = 段 とするのが適当ですが・・・。

本題ですが Excel DB 状態なので、データ接続（ＳＱＬ）を使うのが一般的だと思います。
以下の手順の説明はＥｘｃｅｌ２００７です。

まず、製品表１（Items シート）に ITEM_TABLE と名前を定義します。
手順は、製品表１の範囲を選択して（列名を含めて選択します）、数式タブの定義された名前グループの名前の定義をクリックします。新しい名前ダイアログで名前欄に「ITEM_TABLE」と入力してＯＫで名前を定義します。
次に、製品表２（uom シート）に UOM_TABLE と名前を定義します。
手順は同様です。
ファイルを保存します。（仮に W:\Excel DB.xlsb とします。バイナリ形式です。）

データタブの外部データの取り込みグループのその他のデータソースをクリックします。データ接続ウィザードをクリックします。
「ODBC DSN」を選択し次へ、「Excel Files」を選択し次へ、このファイルを選択します。
次へ、完了。
データのインポートダイアログでプロパティをクリック
接続のプロパティダイアログで「使用」タブの「バックグラウンドで更新する」のチェックを外します。
「定義」タブの「コマンド文字列」にＳＱＬを指定します。

製品表１（ITEM_TABLE）は ID と NAME の２つの列を持ちます。以下、テストデータ
ID NAME
000128 product1
0KV502 product2

製品表２（UOM_TABLE）は ID, CODE, QTY, EAN, VL, WEIGHT, PU と PP の８つの列を持ちます。以下、テストデータ
ID CODE QTY EAN VL WEIGHT PU PP
000128 UNIT 000128 U QTY 000128 U EAN 000128 U VL 000128 U WEIGHT 000128 U PU 000128 U PP
000128 BOX 000128 B QTY 000128 B EAN 000128 B VL 000128 B WEIGHT 000128 B PU 000128 B PP
000128 PALLET 000128 P QTY 000128 P EAN 000128 P VL 000128 P WEIGHT 000128 P PU 000128 P PP
0KV502 UNIT 0KV502 U QTY 0KV502 U EAN 0KV502 U VL 0KV502 U WEIGHT 0KV502 U PU 0KV502 U PP
0KV502 PALLET 0KV502 P QTY 0KV502 P EAN 0KV502 P VL 0KV502 P WEIGHT 0KV502 P PU 0KV502 P PP

上記の構成に対して下のＳＱＬ文をコマンド文字列に指定します。

SELECT i.ID AS ITEM_ID, i.NAME AS ITEM_NAME,
MAX(IIF(u.CODE = 'UNIT', u.CODE, null)) As Unit_Code,
MAX(IIF(u.CODE = 'UNIT', u.EAN, null)) As Unit_EAN,
MAX(IIF(u.CODE = 'UNIT', u.VL, null)) As Unit_VL,
MAX(IIF(u.CODE = 'UNIT', u.PU, null)) As Unit_PU,
MAX(IIF(u.CODE = 'UNIT', u.QTY, null)) As Unit_QTY,
MAX(IIF(u.CODE = 'UNIT', u.WEIGHT, null)) As Unit_WEIGHT,
MAX(IIF(u.CODE = 'UNIT', u.PP, null)) As Unit_PP,
MAX(IIF(u.CODE = 'BOX', u.CODE, null)) As Box_Code,
MAX(IIF(u.CODE = 'BOX', u.EAN, null)) As Box_EAN,
MAX(IIF(u.CODE = 'BOX', u.VL, null)) As Box_VL,
MAX(IIF(u.CODE = 'BOX', u.PU, null)) As Box_PU,
MAX(IIF(u.CODE = 'BOX', u.QTY, null)) As Box_QTY,
MAX(IIF(u.CODE = 'BOX', u.WEIGHT, null)) As Box_WEIGHT,
MAX(IIF(u.CODE = 'BOX', u.PP, null)) As Box_PP,
MAX(IIF(u.CODE = 'PALLET', u.CODE, null)) As Pallet_Code,
MAX(IIF(u.CODE = 'PALLET', u.EAN, null)) As Pallet_EAN,
MAX(IIF(u.CODE = 'PALLET', u.VL, null)) As Pallet_VL,
MAX(IIF(u.CODE = 'PALLET', u.PU, null)) As Pallet_PU,
MAX(IIF(u.CODE = 'PALLET', u.QTY, null)) As Pallet_QTY,
MAX(IIF(u.CODE = 'PALLET', u.WEIGHT, null)) As Pallet_WEIGHT,
MAX(IIF(u.CODE = 'PALLET', u.PP, null)) As Pallet_PP
FROM `W:\Excel DB.xlsb`.ITEM_TABLE i, `W:\Excel DB.xlsb`.UOM_TABLE u
WHERE i.ID = u.ID
GROUP BY i.ID, i.NAME

「このブックの接続先は～」が表示されたら「はい」をクリックします。
出力先はとりあえず新規シートにでもしておいて下さい。
備考　ＸＭＬ形式よりもバイナリ形式の方がパフォーマンスがいいはずです。
ＳＱＬ文のファイルパスを指定（変更）する箇所が２カ所なので注意して下さい。

ここまで、解説しておいてなんですが、Ｅｘｃｅｌファイル（ＡＤＯ、ＯＤＢＣ）に対してＳＱＬ文を実行するのではなく大本のデータベースに対してＳＱＬ文を実行してＥｘｃｅｌにデータを返すようにしてください。
まあ、セキュリティの都合でＥｘｃｅｌファイルにダウンロードしたデータベースのデータしか操作できないなら別ですが・・・。