ワープロのように作成されたエクセルデータの変換方法

質問

ワープロのように作成されたエクセルデータの変換方法

人から提供していただくエクセルデータをつかって、
自分用のデータを作る必要があるのですが、
元のデータがまるでワープロのようです。

　A 　　| 　 B　　　　|　　C　|　　D　　|　　E　　|　F　｜　
氏名　　　 　|選択 　　　 ｜試験１ |　試験２ |　試験３　|　試験４|
山田太郎｜数学（改行）物理　｜ 　○　|　　○　　| 　 ×　　|　× 　　|

試験は数学選択者必須、物理選択者必須、数学と物理選択者必須、どちらかを受験した場合は免除、等でかなりの種類の組合わせ（表の見出し数）があります。

この表を
　A 　| 　 B　|　　C　　　|　　D　　|　　E　　|　　F　　 ｜　
氏名　　|選択 ｜試験１ 　　|試験２　 |試験３　　|試験４　　 |
山田太郎｜数学 　| 試験１○　|試験２○　|試験３ × |試験４　× |
山田太郎｜物理　 | 試験１○　 |試験２○　|試験３ × |試験４　× |

としたいです。
元のデータは１セルの中に改行で複数データが入力されています。
このデータをそれぞれ別のものとして、独立した一行にしたいです。

また、クラスによって試験の種類が違うため、○×だけではなく、試験名もセットで表示しておきたいです。

今考えている方法は

　|　Ｇ 　 | Ｈ 　　| I | 　 J | K | L　 　|
　| 選択１｜選択２ ｜試験１ |試験２ | 試験３　 |試験４　
　| 数学 ｜物理　 | 試験１○　 |試験２○　|試験３ × |試験４　× 　

試験種類と同じ数の列を追加して、
ｉｆと＆を使って試験名と○×をつなげて表示する。

列を追加して[改行でのデータ区切り]を利用して、Ｂ列の内容を１セルずつに区別（Ｇ列とＨ列）する。

という事ですが、
表がとても大きくなってしまいます。
そして、横長にしたデータを次にどうやって選択内容毎に別行のデータにしてよいか困っています。
*実際の選択項目は個人によりばらばらで１～５ほどです。５種選択した人のデータは５行作りたいです。

元データの作り方を変えていただければ一番だとは思うのですが、
なかなかそうもいかないため、自分用のデータになるべく簡単に変換できる方法を探しています。

ぜひアドバイスをお願いいたします。

回答No.2

Wendy02 · ベストアンサー

別のシートにマクロで写すことを考えました。Sheet2 と Sheet3 に、それぞれ分割されて貼り付けられます。しかし、「今考えている方法は……」の部分の文章が、要望なのか、思考過程なのか分かりません。ただ、違う種類の表が出てきた以上Test2()では作りましたが、

>数学（改行）物理
この部分が必ずしも、二つとは限らないわけですから、表の列が揃わなくなります。したがって、項目名はSh2 にはいれません。マクロ否定なら無視してください。

'//
Sub Test1()
　Dim sh1 As Worksheet
　Dim sh2 As Worksheet
　Dim ar As Variant, c As Variant
　Dim i As Long, j As Long, col As Long
　Set sh1 = Worksheets("Sheet1")
　Set sh2 = Worksheets("Sheet2")
　With sh1
　　col = .Cells(1, Columns.Count).End(xlToLeft).Column
　　If sh2.Cells(1, 1).Value = "" Then .Cells(1, 1).Resize(, col).Copy sh2.Cells(1, 1)
　　i = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1
　　Application.ScreenUpdating = False
　　For Each c In .Range("B2", .Cells(Rows.Count, 2).End(xlUp))
　　　If c.Value <> "" Then
　　ar = Split(c.Value, vbLf)
　　For j = 0 To UBound(ar)
　　　sh2.Cells(i, 1).Resize(, col).Value = c.EntireRow.Resize(, col).Value
　　　sh2.Cells(i, 2).Value = ar(j)
　　　i = i + 1
　　Next
　　　End If
　　Next
　　Application.ScreenUpdating = True
　End With
End Sub
'//
Sub Test2()
　Dim sh1 As Worksheet
　Dim sh2 As Worksheet
　Dim ar As Variant, ar2 As Variant, c As Variant
　Dim i As Long, j As Long, k As Long, t As Long
　Dim col As Long
　Set sh1 = Worksheets("Sheet1")
　Set sh2 = Worksheets("Sheet3")
　With sh1
　　col = .Cells(1, Columns.Count).End(xlToLeft).Column
　　i = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1
　　ar2 = Application.Index(.Range("C1", .Cells(1, col)).Value, 1, 0)
　　Application.ScreenUpdating = False
　　For Each c In .Range("B2", .Cells(Rows.Count, 2).End(xlUp))
　　　If c.Value <> "" Then
　　ar = Split(c.Value, vbLf)
　　　sh2.Cells(i, 1).Value = c.Offset(, -1).Value
　　　For j = 0 To UBound(ar)
　　　　sh2.Cells(i, 2 + j).Value = ar(j)
　　　Next
　　　sh2.Cells(i, 3 + UBound(ar)).Resize(, col - 1).Value = c.Offset(, 1).Resize(, col - 1).Value
　　　For k = LBound(ar2) To UBound(ar2)
　　　t = LBound(ar)
　　　　sh2.Cells(i, 3 + k + t) = ar2(k) & " " & sh2.Cells(i, 3 + k + t)
　　　Next
　　　i = i + 1
　　　End If
　　Next
　　Application.ScreenUpdating = True
　End With
End Sub

お礼

Wendy02様

アドバイスありがとうございました。
まだ自分には使いこなせるレベルにはありませんが、
頂いた内容を読み解きながらこの機会にじっくり取り組んでいきます。

具体的な解決方法をご教示頂いたのでベストアンサーにさせていただきます。

回答No.1

Cupper

自分用なら…作り直せばOK。

あれこれ考えるよりも、その場で作り直したほうが早く終わります。
別の Sheet にコピーしてそこで編集しましょう。

お礼

Cupper様
回答ありがとうございます。
かなりの量で、また自分用の作業後、人にパスする資料なので・・・

言葉が足りませんでした。
定期的に必要な作業なので頑張って効率アップさせたいと思います。