バラバラのセルのデータをすべて1行にまとめたい

質問

Excelで添付画像の矢印の先のように、バラバラのセルのデータをすべて1行にまとめたいです。

A列の「医療機関名」ごとにデータを1行に集約させたい、というような意味合いになります。

添付画像の通り、列と列では結合はされていないですが、行と行で結合されていたりいなかったりランダムに数百行あります。
何か楽に1行にまとめる方法はありますか？

わかりづらい点がありましたら教えてください。
よろしくお願いします。

回答No.2

SI299792 · ベストアンサー

上画像をSheet1
下画像をSheet2とします。

Sheet1、ＥＦ列をワークエリアに使います。
E2_ =E1+(Sheet1!A2>"")
F2_ =IF(Sheet1!A3="",F3)+1
纏めて下へコピペ。

Sheet2
A2_ =textjoin(" ",TRUE,OFFSET(Sheet1!A$1,MATCH(ROW()-1,Sheet1!$E:$E,0)-1,0,OFFSET(Sheet1!$F$1,MATCH(ROW()-1,Sheet1!$E:$E,0)-1,0)))
右下へコピペ。

textjoinの使えない旧バージョンでは、VBA の方がいいです。補足に書いて下さい。

お礼

遅くなってすみません。
できました。これでいきます。ありがとうございました。

回答No.4

imogasi

＃３です。
下記データで、まず試行する。
不都合が見つからなければ、本番データのコピーデータでテスト。
D列はそのままに、しているので、手作業で抹消などする。
例データ
aa x x y
y
bb z z u w
u
w
cc s s f g r
f
g
r
A列１－２セル結合
A列３－５セル結合
A列６－９セル結合
D列は第１－９行まで、上記の通り　
F列　実行結果
ーー
標準モジュールに
Sub test01()
Set sh1 = Worksheets("Sheet1")
'ーー最終行探索
lr = sh1.Range("A10000").End(xlUp).Row
MsgBox lr
'--最終行が結合セルである場合の最終データ行の修正
mr = Cells(lr, "A").MergeArea.Rows.Count
MsgBox mr
lr = lr + mr - 1
MsgBox "最終行" & lr
'ーーー
m = 1 '第1行が見出しの場合な２
s = Cells(m, "D")
'-----
For i = 2 To lr '第1行が見出しの場合な３などに修正
If Cells(i, "A") <> "" Then
sh1.Cells(m, "F") = s '貯めたD冽データをF冽セルにセット
s = Cells(i, "D")
m = i
'---結合セルのA列の当行の値は空白を返すので
Else
s = s & " " & Cells(i, "D") 'D冽データをsにため込む
End If
Next i
'--ため込み分吐き出し
sh1.Cells(m, "F") = s
End Sub
実行する。＝F５キーを押す。
結果
例データで挙げた
xv,ZUW,sfgr
の各行。
＝＝＝
・少数例しかテストで来てないこと。
・当方の思慮・スキル不足
・質問者が、コード修正をできないだろう
ので無駄になるかもしれないが。

お礼

遅くなってすみません。
住所の列がF列に1行で出るようになりました。勉強すれば他の列も1行にできそうですね。
これは、一般公開しているデータをCSV化してGoogleマップに読み込ませて私用で使おうとしています。
（行がバラバラだとエラーになってしまうため今回の質問になりました）

回答No.3

imogasi

これは仕事についての課題だろう。
であればVBAを使う必要があると思う。
質問の書き振りから、質問者はVBAを使ったことはないのだろう。だから無理だ。
周りの、VBAを知っている人に聞くか、業者に頼むべきだ、と思う。
ここは、仕事のプログラムの下請けを依頼する、ところではないはず。
また、セルの結合（A列）などをやられるとVBAで処理しづらい。
A列の医療機関名が同じなら、当行のD列のデータを、１行にデータをまとめて行き、A列の結合＝まとまりが終わった（次の医療機関の行に進んだ時）もの（文字列）を先頭行のD列にセットする、ようにプログラムを組む、のも１方法。

回答No.1

NuboChan

Sub 元のセルの文字を残してセル同士を結合する()
Dim x
Dim i As Long
x = Cells(Selection.Row, Selection.Column).Value
For i = 1 To Selection.Rows.Count － 1
x = x & vbCrLf & Cells(Selection.Row + i, Selection.Column)
Cells(Selection.Row + i, Selection.Column) = “” ’結合するなら消さなくても問題ないが、結合しない場合はこの操作が必要
Next i
Cells(Selection.Row, Selection.Column).Value = x
Application.DisplayAlerts = False ’アラームを出ないようにする
Range(Cells(Selection.Row, Selection.Column), Cells(Selection.Row + Selection.Rows.Count － 1, Selection.Column)).MergeCells = True ’セルを結合する
Application.DisplayAlerts = True ’アラームを出るように戻す
End Sub

お礼

遅くなってすみません。
できました。行数が少ない場合は便利ですね。No1の方のE列F列と組み合わせれば全自動化できるんでしょうか