Excel>マクロ＞特定のセルで同じ情報が登録されている行を1行にまとめたい（文字連結）

excelで約2000行ある一覧でA列をキーにして、A列が同じ行のC列とD列の情報を1つのセルにまとめて、別のシートに出力したいです。
１．一覧を一度A列で並び替える
２．C列とD列だけセルの文字を連結する。（画像の一番右側の形）
＜考えていた方法＞
１．A列で別のシートに並び替える
２．A列が同じ行だけ別シートに抽出
３．C列とD列のセルの文字を連結

質問者からの補足コメント

• 画像が追加でアップできなかったので、教えていただいたサイトにアップしなおしました。
  https://gyazo.com/9ed0b7435406250c8e16e743e483b054

    補足日時：2023/01/05 19:36

No.5 ベストアンサー 回答者： tatsumaru77 回答日時： 2023/01/06 09:03

No4です。

すみません。前回のは破棄してください。
前回のは途中に空白行があると正しく動作しません。
こちらを使用してください。

Option Explicit
Public Sub 統合処理()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim maxrow As Long
Dim wrow As Long
Dim row3 As Long
Dim new_str As String
Dim prev_str As String
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set ws3 = Worksheets("Sheet3")
ws2.Cells.ClearContents
maxrow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
ws2.Range("A1").Resize(maxrow, 4).Value = ws1.Range("A1").Resize(maxrow, 4).Value
ws3.Range("A1").Resize(maxrow, 4).Value = ws1.Range("A1").Resize(maxrow, 4).Value
ws3.Rows("2:" & Rows.Count).ClearContents
ws2.Range("A1").Resize(maxrow, 4).Sort key1:=ws2.Range("A1"), Header:=xlYes
prev_str = ""
row3 = 1
For wrow = 2 To maxrow
new_str = ws2.Cells(wrow, "A").Value
If new_str <> prev_str Then
row3 = row3 + 1
ws3.Cells(row3, "A").Resize(1, 4).Value = ws2.Cells(wrow, "A").Resize(1, 4).Value
Else
ws3.Cells(row3, "C").Value = ws3.Cells(row3, "C").Value & vbLf & ws2.Cells(wrow, "C").Value
ws3.Cells(row3, "D").Value = ws3.Cells(row3, "D").Value & vbLf & ws2.Cells(wrow, "D").Value
End If
prev_str = new_str
Next
MsgBox ("完了")
End Sub

この回答へのお礼

確認、連絡が遅くなり申し訳ありません。
希望通りの実行結果が得られました。
自分ではとても考えつかきませんでした。
しかももっと長くなるものだと思っておりましたので、こんなに短く作成できるものなんだと驚いております。
厚く御礼申し上げますm（＿＿）m

お礼日時：2023/01/09 14:22

No.6 回答者： tatsumaru77 回答日時： 2023/01/06 10:56

No5です。

追伸です。
１．Sheet1の1行目は見出し行です。
（Sheet2,Sheet3にも自動的に見出し行が付加されます）

２．Sheet2,Sheet3のA,B,C,D列の幅は、あなたが手動で調整してください。マクロは、幅の調整は行いません。
一度だけ調整すれば、以降は調整の必要はありません。

この回答へのお礼

解説もいただき、ありがとうございました。

お礼日時：2023/01/09 14:24

No.4 回答者： tatsumaru77 回答日時： 2023/01/06 08:49

以下のマクロを標準モジュールに登録してください。

Option Explicit
Public Sub 統合処理()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim maxrow As Long
Dim wrow As Long
Dim row3 As Long
Dim new_str As String
Dim prev_str As String
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set ws3 = Worksheets("Sheet3")
ws1.Range("A1").CurrentRegion.Copy ws2.Range("A1")
ws1.Range("A1").CurrentRegion.Copy ws3.Range("A1")
ws3.Rows("2:" & Rows.Count).ClearContents
ws2.Range("A1").CurrentRegion.Sort key1:=ws2.Range("A1"), Header:=xlYes
maxrow = ws2.Cells(Rows.Count, "A").End(xlUp).Row
prev_str = ""
row3 = 1
For wrow = 2 To maxrow
new_str = ws2.Cells(wrow, "A").Value
If new_str <> prev_str Then
row3 = row3 + 1
ws3.Cells(row3, "A").Resize(1, 4).Value = ws2.Cells(wrow, "A").Resize(1, 4).Value
Else
ws3.Cells(row3, "C").Value = ws3.Cells(row3, "C").Value & vbLf & ws2.Cells(wrow, "C").Value
ws3.Cells(row3, "D").Value = ws3.Cells(row3, "D").Value & vbLf & ws2.Cells(wrow, "D").Value
End If
prev_str = new_str
Next
MsgBox ("完了")
End Sub

No.3 回答者： tatsumaru77 回答日時： 2023/01/05 20:41

No1です。

画像のアップありがとうございました。
補足要求です。
１．シート名ですが、以下の通りで良いですか。
変更前：Sheet1
並び変えたシート：Sheet2
A列が同じ行だけ抽出したシート：Sheet3

２．元のシートに見出し行はないと考えて良いですか。
（1行目からデータの前提で良いですか）
結果的に、他のシートも、見出し行はなくなります。

３．「A列が同じ行だけ、別シートに抽出」ということは、
A列に同じ行がないデータ（A列に同じ値が１件しかない行）は、別シートに出力しなくて良いのでしょうか。
それとも、１件しかなくても、別シートに出力するのでしょうか。

４．B列についてですが、提示されたサンプルをみると、
A列が同じときB列も同じ値になっています。B列が異なるときは、B列のセル内に２行のデータを格納すると考えて良いですか。

例（先頭を１行目とします）
A1　　　　　B1
share_mail1 [e-mail]

A3　　　　　B3
share_mail1 [e-mail]

となっていますが、
B3の値が
[e-mail]
のような場合です。

Sheet3へ出力するのは、
A1　　　　　B1
share_mail1 [e-mail]
　　　　　　[e-mail]
として良いですか。

それとも、A列が同じ場合、無条件にB列も同じになるとみなして良いのでしょうか？
その場合は[e-mail]を無視して
A1　　　　　B1
share_mail1 [e-mail]
と出力します。

５．A列が同じのでソートしたとき、C列とD列は必ず異なっているという前提で良いですか。
例としてSheet1に以下のようなデータがあった場合でも
A列　　　　　B列　　　　　　　　　　C列　　　　　　D列
share_mail1 [e-mail]　田中太郎　　　[e-mail]
share_mail1 [e-mail]　田中太郎　　　[e-mail]
share_mail1 [e-mail]　田中太郎　　　[e-mail]
share_mail1 [e-mail]　田中太郎　　　[e-mail]

Sheet3へ出力するのは
A1　　　　　B1　　　　　　　　　　　C1　　　　　　D1
share_mail1 [e-mail]　田中太郎　　　[e-mail]
　　　　　　　　　　　　　　　　　　田中太郎　　　[e-mail]
　　　　　　　　　　　　　　　　　　田中太郎　　　[e-mail]
　　　　　　　　　　　　　　　　　　田中太郎　　　[e-mail]
になります。
（Ｃ１セル内に４行のデータ、Ｄ１セル内に４行のデータ）

この回答へのお礼

お忙しい中、ご確認いただきありがとうございます。
いただきました追加質問については
以下が回答となります。

■１について
いただいた通りでOKです。

■２について
1行目は可能であれば「見出し行」にしたいと考えています。
しかし、手間であれば、無くても問題ありません。

■３について
1件だけの場合も含めて出力したいと考えております。

■４について
失礼いたしました。データがおかしかったようです。
A列が同じ場合、無条件にB列も同じになるとみなしていただいてOKです。

■５について
記載いただいた通りの認識です。
＞A列が同じのでソートしたとき、C列とD列は必ず異なっているという前提です。
（Ｃ１セル内に４行のデータ、Ｄ１セル内に４行のデータ）

お礼日時：2023/01/05 22:40

No.2 回答者： fujillin 回答日時： 2023/01/05 18:43

こんばんは

手作業でもほとんど手間はかからないと思いますので、以下は手作業での例です。
（マクロはNo1様が回答してくださると思いますので・・）

添付画像が見えないので、文章だけからの回答になりますが・・・
（FILTER関数が使える環境と仮定しています）
1）A列を（仮に）E列にコピペ
2）そのまま、「データ」―「重複の削除」で一意のリストを作成
3）F1セルに
　=TEXTJOIN(CHAR(10),1,FILTER(B:B,$A:$A=$E1))
　を入力し、G1にフィルコピー
4）F1:G1を選択状態で、右下のフィルハンドルをダブルクリック
　（下方に、E列の値がある範囲までフィルコピーされます）

以上で、基本的にできると思います。
セルの表示を「折り返して～」や行の高さを「自動調節」等にしておくと良いでしょう。
4）までの操作は、1～2分もあれば十分と思います。
対象が2000行あると、4）の作業後にエクセルが計算するのに若干時間を要するかも知れません。


※ 上記の結果は関数値になっているので、固定値にしたければ、E:G列を選択し「コピー」-「値をペースト」することで固定文字列にすることができます。

この回答へのお礼

ご教授いただき、ありがとうございます。
本番環境では教えていただいた関数が使えるのは確認出来ているのですが、私個人の環境では確認が出来ません。
その為、後日確認致します。

お礼日時：2023/01/05 20:12

No.1 回答者： tatsumaru77 回答日時： 2023/01/05 16:44

画像がよく見えません。

画像をこのサイトへアップすると荒い画像になってしまします。
gyazo.comへアップされてみてはいかがでしょうか。
下記はgyazo.comへアップしたサンプルです。（画像の内容は本件とは関係ありません）
https://gyazo.com/d54a2d86b804590f4d05fc100a862572