2つのファイルの統合

質問

こんにちは、エクセルファイルの編集についてご教授頂きたく
宜しくお願い致します。

2つの商品データが記入されたCSVファイルがあります。
添付ファイルをご参照願います。

No1のCSVには
　A列連番、B列 商品ID、C列　商品名、D列　価格などが記載されています。

No2のファイルには、
　A列連番、B列 商品ID、C列　商品名、D列　カテゴリ、E列　メーカー　
　以降の列には、重量、サイズなどなどが記載されています。

このファイルを1行の商品IDに横の列に全ての商品情報をまとめ、
１つのファイルにしたいです。

2つのファイルに記載されている商品数が異なるため、ソートしてそのまま
コピーすると、行がずれてしまいます。
No1にのっているIDがNo2にはないものがあります。

No1とNo2のB列の商品IDが同じであれば、No1の商品情報をNo2のファイルの
同じ商品IDの行の後ろの列にコピーしたいです。

同じようなファイルが沢山あるため、関す、VBAなどを使用してできないかと
考えております。
どなたか方法を教えていただけませんでしょうか。

PC　Win10、 Office2013　です。

回答No.4

Prome_Lin · ベストアンサー

すみません！

私、「Result.xlsx」をちゃんと確認していませんでした。

「No2」ファイルの内、「No1」になかった分を追加するとき、列がずれてしまっていました。

そこだけ直したのですが、邪魔くさいので、全体をもう一度、記しておきます。

何度も、すみませんでした。

Option Explicit
Public a, b, c, f, i, j, k, l, m, n, p, s, t, u, v, w, x, y, z
Set s = CreateObject("Scripting.FileSystemObject")
Set t = s.GetFolder(".")
Set u = CreateObject("Excel.Application")

f = "\No1"
Call q
f = "\No2"
Call q

Set v = u.Workbooks.Open(t & "\No1.xlsx")
Set w = v.Worksheets(1)
m = w.Range("A1").End(-4121).Row
Set x = u.Workbooks.Open(t & "\No2.xlsx")
Set y = x.Worksheets(1)
n = y.Range("A1").End(-4121).Row

For i = 4 to 12
w.Cells(1, i + 4).Value = y.Cells(1, i).Value
Next

p = m
For i = 2 to m
For j = 2 to n
If w.Cells(i, 2).Value = y.Cells(j, 2).Value Then
c = 1
For k = 4 to 12
w.Cells(i, k + 4).Value = y.Cells(j, k).Value
Next
Exit For
End IF
Next
Next
For i = 2 to n
c = 0
For j = 2 to m
If y.Cells(i, 2).Value = w.Cells(j, 2).Value Then
c = 1
End If
Next
b = 0
If c = 0 Then
p = p + 1
For k = 1 to 12
If k > 3 Then
b = 4
End If
w.Cells(p, k + b).Value = y.Cells(i, k).Value
Next
End If
Next
v.SaveAs(t & "\Result.xlsx")
v.Close
x.Close
u.Quit
Set z = Nothing
Set y = Nothing
Set x = Nothing
Set w = Nothing
Set v = Nothing
Set u = Nothing
Set t = Nothing
Set s = Nothing

Sub q()
Set v = u.Workbooks.Add()
Set w = v.Worksheets(1)
Set x = s.OpenTextFile(t & f & ".csv")
l = 0
Do Until x.AtEndOfStream
a = Split(x.ReadLine, ",")
l = l + 1
For i = 0 to UBound(a)
w.Cells(l, i + 1).Value = a(i)
Next
Loop
v.SaveAs(t & f & ".xlsx")
v.Close
x.Close
Set x = Nothing
Set w = Nothing
Set v = Nothing
End Sub

回答No.3

Prome_Lin

回答No.2です。

私、アホでした。

先の回答では、「No1」以外の「商品ID」が「No2」にあった場合、無視してしまいます。

すなわち、「No1」より多くなりません。

当然、「No2」に存在するすべてのデータも、１つにしないといけないので、プログラムを書き換えました。

利用方法は「回答No.2」をご覧ください。

Option Explicit
Public a, c, f, i, j, k, l, m, n, p, s, t, u, v, w, x, y, z
Set s = CreateObject("Scripting.FileSystemObject")
Set t = s.GetFolder(".")
Set u = CreateObject("Excel.Application")

f = "\No1"
Call q
f = "\No2"
Call q

Set v = u.Workbooks.Open(t & "\No1.xlsx")
Set w = v.Worksheets(1)
m = w.Range("A1").End(-4121).Row
Set x = u.Workbooks.Open(t & "\No2.xlsx")
Set y = x.Worksheets(1)
n = y.Range("A1").End(-4121).Row

For i = 4 to 12
w.Cells(1, i + 4).Value = y.Cells(1, i).Value
Next

p = m
For i = 2 to m
For j = 2 to n
If w.Cells(i, 2).Value = y.Cells(j, 2).Value Then
c = 1
For k = 4 to 12
w.Cells(i, k + 4).Value = y.Cells(j, k).Value
Next
Exit For
End IF
Next
Next
For i = 2 to n
c = 0
For j = 2 to m
If y.Cells(i, 2).Value = w.Cells(j, 2).Value Then
c = 1
End If
Next
If c = 0 Then
p = p + 1
For k = 1 to 12
w.Cells(p, k).Value = y.Cells(i, k).Value
Next
End If
Next
v.SaveAs(t & "\Result.xlsx")
v.Close
x.Close
u.Quit
Set z = Nothing
Set y = Nothing
Set x = Nothing
Set w = Nothing
Set v = Nothing
Set u = Nothing
Set t = Nothing
Set s = Nothing

Sub q()
Set v = u.Workbooks.Add()
Set w = v.Worksheets(1)
Set x = s.OpenTextFile(t & f & ".csv")
l = 0
Do Until x.AtEndOfStream
a = Split(x.ReadLine, ",")
l = l + 1
For i = 0 to UBound(a)
w.Cells(l, i + 1).Value = a(i)
Next
Loop
v.SaveAs(t & f & ".xlsx")
v.Close
x.Close
Set x = Nothing
Set w = Nothing
Set v = Nothing
End Sub

補足

ありがとうございます！
すごいスクリプトですねー　ビックリです。。
1つ目の投稿頂いたのは正常に完了したのですが、2つ目がNO２のデータ
入らなかったです。明日再度別ファイルなどで確認してみます。
取り急ぎ御礼まで。

回答No.2

Prome_Lin

「VBScript」でプログラムを書きました。

「VBScript」にした理由は、元ファイルが「csv」ファイルのため、「VBA」だと、エクセルを立ち上げて、マクロを実行する、という手間が生じますが、「VBScript」なら、プログラムファイルをダブルクリックするだけです。

まず、前提条件です。

「No1.csv」と「No2.csv」の２つのファイルが、同じフォルダ内にあるものとします。

「No1」「No2」とも、２列目が「商品ID」で、「No1」は、７（Ｇ）列まで、「No2」は、１２（Ｌ）列まであるものとします。

このフォルダ内には、「No1.xlsx」「No2.xlsx」「Result.xlsx」という名前のファイルがあってはいけません。

以上の条件下で、以下のプログラムをメモ帳かテキストファイルにコピー＆ペーストし、「～.vbs」という名前で、同じフォルダに保存します。

「～」の部分は何でも構いませんが、最後の「.vbs」は、必ず半角英字で「.vbs」とします。

「No1.csv」と「No2.csv」のあるフォルダに「～.vbs」を放り込んで、ダブルクリック（シングルクリック→「Enter」の方が確実）すると、「No1.xlsx」「No2.xlsx」「Result.xlsx」というファイルが、同じフォルダ内に出来ます。

もちろん「Result.xlsx」ファイルが結果ファイルです。

Option Explicit
Public a, f, i, j, l, s, t, u, v, w, x, y, z
Set s = CreateObject("Scripting.FileSystemObject")
Set t = s.GetFolder(".")
Set u = CreateObject("Excel.Application")
On Error Resume Next
f = "\No1"
Call q
f = "\No2"
Call q

Set v = u.Workbooks.Open(t & "\No1.xlsx")
Set w = v.Worksheets(1)
Set x = u.Workbooks.Open(t & "\No2.xlsx")
Set y = x.Worksheets(1)

For i = 4 to 12
w.Cells(1, i + 4).Value = y.Cells(1, i).Value
Next
For i = 2 to w.Range("A:A").End(-4121).Row
Set z = y.Range("B:B").Find(w.Cells(i, 2).Value)
For j = 4 to 12
w.Cells(i, j + 4).Value = y.Cells(z.Row, j).Value
Next
Next
v.SaveAs(t & "\Result.xlsx")
v.Close
x.Close
u.Quit
Set z = Nothing
Set y = Nothing
Set x = Nothing
Set w = Nothing
Set v = Nothing
Set u = Nothing
Set t = Nothing
Set s = Nothing

Sub q()
Set v = u.Workbooks.Add()
Set w = v.Worksheets(1)
Set x = s.OpenTextFile(t & f & ".csv")
l = 0
Do Until x.AtEndOfStream
a = Split(x.ReadLine, ",")
l = l + 1
For i = 0 to UBound(a)
w.Cells(l, i + 1).Value = a(i)
Next
Loop
v.SaveAs(t & f & ".xlsx")
v.Close
x.Close
Set x = Nothing
Set w = Nothing
Set v = Nothing
End Sub

もし、興味がおありになるといけないので、簡単なプログラムの説明をしておきます。

Set s = CreateObject("Scripting.FileSystemObject")

「VBScript」はそのままでは、ファイルやフォルダを扱えないので、この１行で、扱えるようにしています。

Set t = s.GetFolder(".")

今、プログラムファイル（「～.vbs」）が存在するフォルダを取得。

Set u = CreateObject("Excel.Application")

もちろん、エクセルもそのままでは扱えないので、この１行で、扱えるようにしています。

On Error Resume Next

「Find()」という文を使っているのですが、この「Find()」、存在しなかった（見つからなかった）場合は、エラーになって止まってしまうので、エラーを無視しています。

f = "\No1"
Call q
f = "\No2"
Call q

ファイル名を「No1」と設定して、「q」というサブプロシージャを呼び出し、次にファイル名を「No2」と設定して、「q」サブプロシージャを呼び出しています。

先に、一番下の方にある「Sub q()」の説明です。

Set v = u.Workbooks.Add()
Set w = v.Worksheets(1)

エクセルのファイルを新規作成し、その一番左端のシートを「w」にセットしています。

Set x = s.OpenTextFile(t & f & ".csv")

上で、ファイル名を設定した「csv」ファイルを開いています。

Do Until x.AtEndOfStream

テキストファイルが終わるまで処理を続けます。

a = Split(x.ReadLine, ",")

１行読み込み、「,」で分割して、配列変数「a」に入れています。
（すなわち、もし、読み込んだ１行が、「1,2,3」なら「a(0)=1」「a(1)=2」「a(2)=3」となります）

l = l + 1

行数をカウントしています。

For i = 0 to UBound(a)

「i」が「0」から、今読み込んだ配列変数「a」の最後（上記の「1,2,3」なら最大は「a(2)=3」なので、a(2)の「２」）の値まで、処理を続けます。

w.Cells(l, i + 1).Value = a(i)

セルに、配列変数「a」の値を書き込んでいます。

v.SaveAs(t & f & ".xlsx")

「csv」ファイルと同じ名前（「f」）のエクセルファイルとして保存しています。

これで、「No1.xlsx」と「No2.xlsx」というファイルが同じフォルダ内に出来ました。

上に戻って、

Set v = u.Workbooks.Open(t & "\No1.xlsx")
Set w = v.Worksheets(1)
Set x = u.Workbooks.Open(t & "\No2.xlsx")
Set y = x.Worksheets(1)

「No1.xlsx」と「No2.xlsx」ファイルを開け、それぞれ１番左端のシートをセットしています。

For i = 4 to 12
w.Cells(1, i + 4).Value = y.Cells(1, i).Value
Next

「No2.xlsx」から、「No1.xlsx」ファイルにない項目名をコピー。

For i = 2 to w.Range("A:A").End(-4121).Row

「No1」の「A」列の一番最後の行を取得。

Set z = y.Range("B:B").Find(w.Cells(i, 2).Value)

「No1」の「商品ID」を順番に読み込み「Find()」で、「No2」の中の「商品ID」を検索しています。

For j = 4 to 12
w.Cells(i, j + 4).Value = y.Cells(z.Row, j).Value
Next

見つかるのが前提なのですが、見つかった場合、「No1」の方に、「No2」の後ろの方をコピーして、１行につなげています。
（見つからなかった場合は、本当はエラーになって、止まってしまうのですが、上述のとおり、無視して作業を続けてしまいます。）

「No1.xlsx」を「Result.xlsx」という名前に変えて保存しています。

あとは、終了処理です。

回答No.1

VitaminBB

ちょっと頭がこんがらがるかもしれませんが、このテクニックを知っておくとVBAなど組まなくても可能で今後も役に立ちます。
・NO1の商品名とNO2の商品名を抜き出して縦に並べます。
１クラウン
１パジェロ
１デミオ
・
・
２パジェロ
２ノート
２ムーブ
・
・

・データフィルタの詳細設定にある”重複するレコードを無視する”で重複のないデータ一覧を作成する。これで全商品の一覧が出来ました。
１クラウン
１パジェロ
１デミオ
２ノート
２ムーブ
・
・

・これをNO1の商品の下に貼り付け、また重複するレコードを無視するを使う。
以上で全商品の一覧が出来、NO１の商品のみ各列にデータが入りますよね。
１クラウン・・・・
１パジェロ・・・・
１デミオ・・・・
２ノート
２ムーブ

同様のことをNO2にも行います。
２パジェロ・・・・
２ノート・・・・
２ムーブ・・・・
１クラウン
１デミオ

NO1の車名を昇順で並び替えると
１クラウン・・・・
１デミオ・・・・
２ノート
１パジェロ・・・・
２ムーブ

NO2の車名を昇順で並び替えると
１クラウン
１デミオ
２ノート・・・・
２パジェロ・・・・
２ムーブ・・・・

NO１とNO2の車名合わせてを昇順で並び替えると
１クラウン・・・・
１クラウン
１デミオ・・・・
１デミオ
２ノート
２ノート・・・・
１パジェロ・・・・
２パジェロ・・・・
２ムーブ
２ムーブ・・・・

このデータをコピーして1行ずらして横に並べると
　　　　　　　　　　　　1クラウン・・・・
１クラウン・・・・　　　１クラウン
１クラウン　　　　　　　１デミオ・・・・
１デミオ・・・・　　　　１デミオ
１デミオ　　　　　　　　２ノート
２ノート　　　　　　　　２ノート・・・・
２ノート・・・・　　　　１パジェロ・・・・
１パジェロ・・・・　　　２パジェロ・・・・
２パジェロ・・・・　　　２ムーブ
２ムーブ　　　　　　　　２ムーブ・・・・
２ムーブ・・・・

・このデータの先頭列に１と２を追加します。
１　　　　　　　　　　　　　1クラウン・・・・
２　１クラウン・・・・　　　１クラウン
１　１クラウン　　　　　　　１デミオ・・・・
２　１デミオ・・・・　　　　１デミオ
１　１デミオ　　　　　　　　２ノート
２　２ノート　　　　　　　　２ノート・・・・
１　２ノート・・・・　　　　１パジェロ・・・・
２　１パジェロ・・・・　　　２パジェロ・・・・
１　２パジェロ・・・・　　　２ムーブ
２　２ムーブ　　　　　　　　２ムーブ・・・・
１　２ムーブ・・・・

・このデータの先頭列の１と２で昇順に並べ変えると
１　　　　　　　　　　　　　1クラウン・・・・
１　１クラウン　　　　　　　１デミオ・・・・
１　１デミオ　　　　　　　　２ノート
１　２ノート・・・・　　　　１パジェロ・・・・
１　２パジェロ・・・・　　　２ムーブ
１　２ムーブ・・・・
２　１クラウン・・・・　　　１クラウン
２　１デミオ・・・・　　　　１デミオ
２　２ノート　　　　　　　　２ノート・・・・
２　１パジェロ・・・・　　　２パジェロ・・・・
２　２ムーブ　　　　　　　　２ムーブ・・・・

・先頭列の２だけ残すと目的が達成できました。
２　１クラウン・・・・　　　１クラウン
２　１デミオ・・・・　　　　１デミオ
２　２ノート　　　　　　　　２ノート・・・・
２　１パジェロ・・・・　　　２パジェロ・・・・
２　２ムーブ　　　　　　　　２ムーブ・・・・

お礼

返信誠にありがとうございまず！
こんな方法があるのですね＾＾
全く思いつきませんでした。
少し混乱しましたが、助かりました。