エクセルの重複データを整理する方法

質問

毎日の生産管理でエクセル２０００を使用しています。
A列に製品名、B列に生産個数というように入力。
重複したデータが日替わりのように発生していますので、
あとでデータ整理するのが大変です。

　　　A　　　　B　　　　C　　　 D　　　・・・・
１　A製品　　200
２　B製品　　200
３　C製品　　250
４　A製品　　100
５　D製品　　300
６　E製品　　120
７　C製品　　600
８　B製品　　 50
・
教えて！欲しいのは下記のように重複したデータ（製品名）の場合、
既存の製品の行の空白セルに生産個数を自動的に書き込み、整理する方法。

　　　A　　　　B　　　　C　　　　D ・・・・
１　A製品　　200　　100
２　B製品　　200　　50
３　C製品　　250　　600
４　D製品　　300　　
５　E製品　　120　　
６　
７　
８
・
いろいろ「エクセル　重複データ」に関する質問を検索したのですが、
これに当てはまる質問を見つけられず、意を決して投稿しました。
マクロ、VBAでも構いませんので、どうかご教授願います。

回答No.2

keithin · ベストアンサー

ALT+F11を押す
挿入メニューから標準モジュールを挿入する
挿入したシートに下記をコピー貼り付ける

sub macro1()
　dim i,r
　i = 1
　do until cells(i, "A") = ""
　　r = application.match(cells(i, "A"), range("A:A"),0)
　　if i <> r then
　　　cells(r, "IV").end(xltoleft).offset(0, 1) = cells(i, "B")
　　　cells(i, "A").entirerow.delete shift:=xlshiftup
　　else
　　　i = i + 1
　　end if
　loop
end sub

ファイルメニューから終了してエクセルに戻る
マクロを実行する。

＃まずご質問でご自分が掲示されたとおりにサンプルを作って寄せられたそれぞれの回答を実行し，キチンと出来ることを確認してから実地に使用するようにしてください。

お礼

私が望んだ通りの方法です。
これで、作業が効率よく出来ると思います、
有難うございました。

回答No.5

merlionXX

ANo3です。
コードの貼り付けミスがありました。
差し替えてください。

Sub TEST01()
　　Dim myDic As Object '変数宣言
　　Dim c As Range '変数宣言
　　Dim ns As Worksheet '変数宣言
　　Set myDic = CreateObject("Scripting.Dictionary") 'myDicを用意
　　For Each c In Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp)) 'A列の各データについて
　　　　If Not myDic.exists(c.Value) Then 'myDicになければ
　　　　　　myDic.Add c.Value, c.Offset(0, 1).Value '追加しB列データを結びつける
　　　　Else 'myDicにあれば
　　　　　　myDic(c.Value) = myDic(c.Value) & "_" & c.Offset(0, 1).Value '"_" でつないでB列データを結びつける
　　　　End If
　　Next c '繰り返し
　　Set ns = Worksheets.Add(After:=ActiveSheet) 'シートを追加
　　With ns '追加したシートで
　　　　.Range("A1").Resize(myDic.Count, 1).Value = Application.Transpose(myDic.Keys) 'A列にデータ
　　　　.Range("B1").Resize(myDic.Count, 1).Value = Application.Transpose(myDic.Items) 'B列に結びつけデータ
　　　　.Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, OtherChar:="_" 'B列データを"_"で分解
　　End With
　　Set myDic = Nothing
　　Set ns = Nothing
End Sub

お礼

有難うございました。

説明不足だったかもしれませんね。
後でグラフ作成するにあたって、同一セルにアンダーバーで区切る方法は
不向きだったようです。

merlionXXさんのコードを勉強し、集計シートの自動作成に
チャレンジしてみたいと思います。

回答No.4

nayuta_lot

こんにちは

集計するだけでよいなら、簡単ですが

１．Sheet1のＡ１からＡ８（最終行）までコピーします。

２．Sheet2のＡ１にペーストします。

３．ペーストの後、範囲指定されたままの状態でメニューのデータから『重複を削除』をクリック
　　します。

４．Sheet2のＢ１に　『=SUMIF(Sheet1!$A:$A,A1,Sheet1!$B:$B)』

　　と入力して、Ａ列の最終行と同じ行まで、Ｂ１をコピー＆ペーストします。

６．４まで一回やっておけば、あとは、データが増えるたびに１から３までを繰り返して
　　Ａ列の最終行が増えたら、Ｂ１も同じ行までコピーすればＯＫです。

　　SUMIF関数の参考ＵＲＬ
　　　　↓↓↓
　　http://kokoro.kir.jp/excel/sumif.html

手作業ですが、そんなに手間でもありませんので、こうゆうやりかたもあるくらいに
参考にしてください。
それでは

お礼

他のデータファイルで試して見ます。
大変、有難うございました。

回答No.3

merlionXX

関数ではやたら面倒だと思いますのでVBAでの方法です。
VBAの使い方はご存知なのですね？
標準モジュールに以下をコピペして、データがあるシートをアクティブな状態（選択した状態）にしてからTEST01を実行してください。
新たにシートを追加して、そのシートに自動的に展開します。

Sub TEST01()
　　Dim myDic As Object '変数宣言
　　Dim c As Range '変数宣言
　　Dim ns As Worksheet '変数宣言
　　Set myDic = CreateObject("Scripting.Dictionary") 'myDicを用意
　　For Each c In Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp)) 'A列の各データについて
　　　　If Not myDic.exists(c.Value) Then 'myDicになければ
　　　　　　myDic.Add c.Value, c.Offset(0, 1).Value '追加しB列データを結びつける
　　　　Else 'myDicにあれば
　　　　　　myDic(c.Value) = myDic(c.Value) & " " & c.Offset(0, 1).Value '" " でつないでB列データを結びつける
　　　　End If
　　Next c '繰り返し
　　Set ns = Worksheets.Add(After:=ActiveSheet) 'シートを追加
　　With ns '追加したシートで
　　　　.Range("A1").Resize(myDic.Count, 1).Value = Application.Transpose(myDic.Keys) 'A列にデータ
　　　　.Range("B1").Resize(myDic.Count, 1).Value = Application.Transpose(myDic.Items) 'B列に結びつけデータ
　　　　.Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, OtherChar:=" " 'B列データを" "で分解
　　End With
　　Set myDic = Nothing
　　Set ns = Nothing
End Sub

回答No.1

KURUMITO

シート1のA列およびB列の1行目からお示しのデータがあるとして、作業列をC列に設け、C1セルには次の式を入力して下方にオートフィルドラッグします。

=IF(A1="","",A1&COUNTIF(A$1:A1,A1))

シート2にお求めの表を作成するとしてA1セルから下方には製品名を入力します。
B1セルには次の式を入力して右横方向にオートフィルドラッグしたのちに下方向にもオートフィルドラッグします。

=IF($A1="","",IF(COUNTIF(Sheet1!$C:$C,$A1&COLUMN(A1))=0,"",INDEX(Sheet1!$B:$B,MATCH($A1&COLUMN(A1),Sheet1!$C:$C,0))))

お礼

大変参考になりました。
他の資料に使えそうです、大変有難うございました。