同じ名前があれば数値のみ追加、無ければ名前と数値を追加

質問

花.xlsのsheet1に

Ａ列　　　　　　Ｂ列
バラ　　　　　　　2
コスモス 　　　4
バラ　　　　　　　5
ひまわり　　　　 5
コスモス　　　　 8　
欄　　　　　　　　 3

と花の種類と本数があります

VBAのコマンドボタンを押すと

在庫.xlsのＡ列とＢ列に
A列 B列
バラ　 　　 　7
コスモス 　　　12
ひまわり　　　　5
欄　　　　　　　　3　　

と花の名前を1つにして合計の本数を書き出すのですが

以下のページを参考のwatabe007さんの掲載を参考にさせて頂いて
出来るようになりました

http://questionbox.jp.msn.com/qa5631643.html

watabe007さんのアドバイス

Private Sub CommandButton1_Click()
　　Dim myDic As Object
　　Dim c As Range

　　Set myDic = CreateObject("Scripting.Dictionary")
　　For Each c In Range("A1", Cells(Rows.Count, "A").End(xlUp))
　　　　myDic(c.Value) = myDic(c.Value) + c.Offset(, 1).Value
　　Next
　　Range("D1").Resize(myDic.Count, 2).Value = _
　　　　Application.Transpose(Array(myDic.Keys, myDic.Items))
End Sub

>指定したエクセルファイル”kekka.xls”に
D1セルに出力していますので応用してください。

ここからが今回の質問です。

前出の”花.xls”の他に

花２.xlsがあり
A列　　　　　　　　Ｂ列
カーネーション　 6
バラ 　　 　　 2
椿　　　　　　　　　3
カーネーション　　2
欄　　　　　　　　　6
菊　　　　　　　　　2
椿　　　　　　　　　5
ひまわり　　　　　9
バラ　　　　　　　　　3

と言う内容です。

やはりＶＢＡのコマンドボタンをクリックすると

在庫.xlsのＣ列に本数を書き加えたいのですが
最初に花.xlsの情報がありますので
今度は同じ花の名前があればそのＣ列に本数を追加し
同じ名前の花が無ければＡ列に花の名前を追加して
Ｃ列に本数を書き加えたいのです。

Ａ列　　　　　　　Ｂ列　　　　　　 Ｃ列
バラ　　　　　　　　7　　　　　　　　 5
コスモス 　　　　12
ひまわり　　　　　5　　　　　 9
欄　　　　　　　　　3　　　　　　　　 6　
カーネーション　　　　　　　　 8
椿　　　　　　　　　　　　　　　 　　8
菊　　　　　　　　　　　　　　　　 　2　

どうぞよいお知恵をお貸しください、
お願いします。

回答No.3

watabe007 · ベストアンサー

別案
Private Sub CommandButton1_Click()
　　Dim sh1 As Worksheet, sh2 As Worksheet
　　Dim c As Range, myR As Variant

　　Set sh1 = Workbooks("在庫.xls").Worksheets("Sheet1")
　　Set sh2 = Workbooks("花２.xls").Worksheets("Sheet1")
　　For Each c In sh2.Range("A1", sh2.Cells(Rows.Count, "A").End(xlUp))
　　　　myR = Application.Match(c.Value, sh1.Columns(1), 0)
　　　　If Not IsError(myR) Then
　　　　　　sh1.Cells(myR, "C").Value = sh1.Cells(myR, "C").Value + c.Offset(, 1).Value
　　　　Else
　　　　　　With sh1.Cells(Rows.Count, "A").End(xlUp)
　　　　　　　　.Offset(1).Value = c.Value
　　　　　　　　.Offset(1, 2).Value = c.Offset(, 1).Value
　　　　　　End With
　　　　End If
　　Next
End Sub

回答No.4

watabe007

在庫.xls　Ａ列のバラ、ひまわり、欄　と
花２.xls　Ａ列のバラ、ひまわり、欄　が違う文字列と処理されています
どちらかに スペースなどが入っていませんか？

お礼

watabe007さん

おっしゃるとおり、スペースが入っていました、
そしてスペースを取り除き同じ文字列にすることでうまく行きました。
感動しました。

watabe007さんのコードは大変シンプルでスッキリしてかっこよく見えます。

大変ありがとう御座いました、
心から感謝しています。

回答No.2

watabe007

補足説明
在庫.xlsのＡ列の品名のみ取得します
ここでＡ列に重複する品名があると正しい結果が表示されませんので要注意！！
　　With Workbooks("在庫.xls").Worksheets("Sheet1")
　　　　For Each c In .Range("A1", .Cells(Rows.Count, "A").End(xlUp))
　　　　　　myDic(c.Value) = Empty
　　　　Next
　　End With
在庫.xlsで得た品名に花２.xlsの品名、数量を加算しています。
　　With Workbooks("花２.xls").Worksheets("Sheet1")
　　　　For Each c In .Range("A1", .Cells(Rows.Count, "A").End(xlUp))
　　　　　　myDic(c.Value) = myDic(c.Value) + c.Offset(, 1).Value
　　　　Next
　　End With
　　With Workbooks("在庫.xls").Worksheets("Sheet1")
在庫.xlsのＡ列に品名を転記
　　　　.Range("A1").Resize(myDic.Count).Value = Application.Transpose(myDic.Keys)
在庫.xlsのＣ列に数量を転記
　　　　.Range("C1").Resize(myDic.Count).Value = Application.Transpose(myDic.Items)
　　End With
オブジェクトmyDicの開放
　　Set myDic = Nothing

お礼

watabe007さん
大変お世話になってます！

お教え頂いたものを試しているのですが、こちらではうまく行きません。

やっていることは、
花２.xlsに以下の情報が入っています。
Ａ列　　　　　　　　　　　　Ｂ列
カーネーション 6
バラ 　　 　　 2
椿　　　　　　 3
カーネーション 2
欄　　　　　　 6
菊　　　　　　 2
椿　　　　　　 5
ひまわり　　　 9
バラ　　　　　 3

そして借用させて頂いたＶＢＡのコマンドボタンを付け

在庫.xlsには
Ａ列　　　　　Ｂ列
バラ　 　 7
コスモス 12
ひまわり 5
欄　　　 3

が既に入っています。

ここでコマンドボタンを押すと以下のようになり
うまく行きません。

バラ　 　 7
コスモス 12
ひまわり 5
欄　　　 3
カーネーション 8
バラ 　　 　　 2
椿　　　　　　 8
欄　　　　　　 6
菊　　　　　　 2
ひまわり　　　 9
バラ　　　　　 3

わたしが望んでいるのは、

Ａ列　　　　　　　Ｂ列　　　　　　 Ｃ列
バラ　　　　　　　　7　　　　　　　　 5
コスモス 　　　　12
ひまわり　　　　　5　　　　　 9
欄　　　　　　　　　3　　　　　　　　 6　
カーネーション　　　　　　　　 8
椿　　　　　　　　　　　　　　　 　　8
菊　　　　　　　　　　　　　　　　 　2　

のように花の名前が重複することなく既に花xlsにある花の名前があればそのＣ列に数を記入し、無い名前のものはＡ列の末尾に花の名前を追加し、そのＣ列に数を記入していく感じです。

何かこちらのミスがあるのでしょうか？
何卒お付き合いの程お願い致します

回答No.1

watabe007

どうぞ～
Private Sub CommandButton1_Click()
　　Dim myDic As Object
　　Dim c As Range

　　Set myDic = CreateObject("Scripting.Dictionary")
　　With Workbooks("在庫.xls").Worksheets("Sheet1")
　　　　For Each c In .Range("A1", .Cells(Rows.Count, "A").End(xlUp))
　　　　　　myDic(c.Value) = Empty
　　　　Next
　　End With
　　With Workbooks("花２.xls").Worksheets("Sheet1")
　　　　For Each c In .Range("A1", .Cells(Rows.Count, "A").End(xlUp))
　　　　　　myDic(c.Value) = myDic(c.Value) + c.Offset(, 1).Value
　　　　Next
　　End With
　　With Workbooks("在庫.xls").Worksheets("Sheet1")
　　　　.Range("A1").Resize(myDic.Count).Value = Application.Transpose(myDic.Keys)
　　　　.Range("C1").Resize(myDic.Count).Value = Application.Transpose(myDic.Items)
　　End With
　　Set myDic = Nothing
End Sub