複数行あるＥｘｃｅｌのある列の情報を統合したい

質問

以下のことを、Ｅｘｃｅｌ２０１０のＶＢＡで実施したいのですが、どなたかご教示いただけないでしょうか。
これまで、ＶＢＡを自身で作成したことがなく、お手上げ状態につき、どうかよろしくお願いします。

実施したいことは、下記または添付画像のように、
「品名」（A列）、「品番」（B列）および他の列項目（###）のデータが完全一致の場合、ひとつの行に統合して、「エラー番号」（列D）のデータを列Dの中で、セミコロン区切りで結合させる、
です。

・統合元となった行は、「エラー番号」の統合後に削除する。
・「品名」AAAの「エラー番号」NO333のように統合後の「エラー番号」にダブリが残っても構いません。
・件数の上限はありません（Excel2010の上限1048576まで対象行があると想定）
・他の項目（###）は複数あるのですが、「エラー番号」の列がD列という前提でお願いします。

【VB実行前】
列A 列B 列C 列D
品名 品番 ### エラー番号
AAA A123 ### NO111;NO333
BBB B123 ###
CCC C123 ### NO111
AAA A123 ### NO222;NO333
CCC C123 ### NO555
AAA A12345 ### NO222
CCC C12345 ### NO111
AAA A123 ### NO999

【VB実行後】
列A 列B 列C 列D
品名 品番 ### エラー番号
AAA A123 ### NO111;NO333;NO222;NO333;NO999
BBB B123 ###
CCC C123 ### NO111,NO555
AAA A12345 ### NO222
CCC C12345 ### NO111

回答No.1

tom04 · ベストアンサー

こんにちは！
シートモジュールにしていますので
画面左下の操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。

Sub Sample1()
Dim i As Long, k As Long
i = Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
Columns(1).Insert
Range(Cells(2, 1), Cells(i, 1)).Formula = "=B2&""_""&C2"
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
For k = i + 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 1) = Cells(k, 1) And Cells(k, 5) <> "" Then
Cells(i, 5) = Cells(i, 5) & ";" & Cells(k, 5)
Cells(k, 1).Resize(1, 5).ClearContents
End If
Next k
Next i
Columns(1).Delete
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(i, 1) = "" Then
Rows(i).Delete
End If
Next i
Columns.AutoFit
Application.ScreenUpdating = True
End Sub

こんな感じではどうでしょうか？m(_ _)m

お礼

tom04様、質問時に期待していた結果を実行するマクロそのものでした！　感動のあまり思わず体が震えてしまいました。

MarcoRossiItaly様、仰られることごもっともです。今回の場合、ピポットをはじめＥｘｃｅｌの既存機能を利用してかなり近いことができることは思いつきませんでした。わざわざ追加版の情報も有難うございます。私にとっては次元が高いですが勉強になります。

keithin様、tom04様とは違ったマクロで、私のレベルでは理解困難な色々な処理を裏でされておられるようで時間をかけて勉強させていただきたいと思います。

今回、マクロの記録や色々な投稿を参考に組合わせで対応しようと試行錯誤しましたが断念し、こちらに相談させていただきましたが、このように直ぐに期待以上の御回答をいただきまして本当に有難うございました。
はじめてこちらを使用したため、お礼と相談済みの方法が分からず、お礼が遅くなり大変失礼しました。

回答No.4

MarcoRossiItaly

No.2 です、何度もすみません。最終的に残す行を選別するために、G 列に「抽出」という列でも設けてください。

E2　=(a1=a2)*(b1=b2)
F2　=if(e2,f1&";",)&d2
G2　=e3=0　　　　　　　←入力セルの行番号と数式の行番号が異なります

それと、E1 セルの日本語の表現がうまくないので、「2件目以上」と、ついでに改めさせていただきました。

回答No.3

keithin

データが極めて沢山あることを前提に高速化を企図すると

sub macro1()
　dim LastRow as long

　activesheet.copy before:=activesheet
　lastrow = cells.specialcells(xlcelltypelastcell).row
　range("E:F").insert
　range("A:B").insert

　range("A1:A" & lastrow).formula = "=ROW()"
　range("B1:B" & lastrow).formula = "=C1&"",""&D1&"",""&E1"　’適宜調整
　range("A1:B" & lastrow).value = range("A1:B" & lastrow).value
　range("A1").currentregion.sort key1:=range("B1"), order1:=xlascending, header:=xlyes

　range("G1:G" & lastrow).formula = "="";""&F1&IF(B1=B2,G2,"""")"
　range("H1:H" & lastrow).formula = "=MID(G1,2,LEN(G1))"
　range("G1:H" & lastrow).value = range("G1:H" & lastrow).value

　range("A1").currentregion.removeduplicates columns:=2, header:=xlyes
　range("A1").currentregion.sort key1:=range("A1"), order1:=xlascending, header:=xlyes
　range("A:B,F:G").delete shift:=xlshifttoleft

end sub

回答No.2

MarcoRossiItaly

VB ではなく VBA のほうということでいいですね？ VBA を扱ったことがないとのことですが、意味も分からずコードを実行するというのは危険な場合もあるので、プログラムは基本的に、ご自分で最低限の内容は理解できたものを利用するほうがいいです。

ご質問のような、Excel の一般機能の範ちゅうを出ない処理において、VBA を使う意味というのは、単に手作業で行うよりも（うまく準備すれば）ラクに高速にできるというだけだとお考えください。

さて、お望みのことを私が行うとしたら、先に D 列、B 列、A 列の順に、並べ替えを行います。必要ならフィルタを取り付けます。ピボットテーブルを使えば、それよりももう少し整理された表を作製することもできます。並べ替えなどができたら、D 列の文字列を結合していくのは、簡単な数式でできます。

また、質問者さんの最終的な目的のためには、本当に文字列の結合という処理を行う必要があるのかという点も、一応、確認してください。

並べ替え、フィルタ、ピボットテーブル、文字列の結合、行の削除、どれも勿論 VBA でもできますが、処理するシートやファイルが大量に存在するなどの事情がなければ、VBA を使う意義があまりありません。コードをイチイチ書かなくて済む分、手作業で行ったほうが早いです。ちょっとでも間違っていると正しく動きませんので、全然お手軽ではないです。No.1 さんのようなエキスパートでもない限り。

添付図では、質問文の上の表内をクリックして並べ替え（リボン「データ＞並べ替え」）した後で、E・F 列に次式を入力しています。

E2　=(a1=a2)*(b1=b2)
F2　=if(e2,f1&";",)&d2