• ベストアンサー

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

Excelで添付画像の矢印の先のように、バラバラのセルのデータをすべて1行にまとめたいです。 A列の「医療機関名」ごとにデータを1行に集約させたい、というような意味合いになります。 添付画像の通り、列と列では結合はされていないですが、行と行で結合されていたりいなかったりランダムに数百行あります。 何か楽に1行にまとめる方法はありますか? わかりづらい点がありましたら教えてください。 よろしくお願いします。

質問者が選んだベストアンサー

  • ベストアンサー
  • SI299792
  • ベストアンサー率47% (780/1630)
回答No.2

上画像をSheet1 下画像をSheet2とします。 Sheet1、EF列をワークエリアに使います。 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 の方がいいです。補足に書いて下さい。

t_kanei
質問者

お礼

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

その他の回答 (3)

  • imogasi
  • ベストアンサー率27% (4737/17069)
回答No.4

#3です。 下記データで、まず試行する。 不都合が見つからなければ、本番データのコピーデータでテスト。 D列はそのままに、しているので、手作業で抹消などする。 例データ aa x x y y bb z z u w u w cc s s f g r f g r A列1-2セル結合 A列3-5セル結合 A列6-9セル結合 D列は第1-9行まで、上記の通り  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行が見出しの場合な2 s = Cells(m, "D") '----- For i = 2 To lr '第1行が見出しの場合な3などに修正 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 実行する。=F5キーを押す。 結果 例データで挙げた xv,ZUW,sfgr の各行。 === ・少数例しかテストで来てないこと。 ・当方の思慮・スキル不足 ・質問者が、コード修正をできないだろう ので無駄になるかもしれないが。

t_kanei
質問者

お礼

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

  • imogasi
  • ベストアンサー率27% (4737/17069)
回答No.3

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

  • NuboChan
  • ベストアンサー率47% (790/1658)
回答No.1

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

t_kanei
質問者

お礼

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

関連するQ&A

専門家に質問してみよう