複数の縦方向に並んだ表を並べ変える方法

質問

以下のように縦方向に多数の表が並んでおり、それを別の形式に並べ替えたいのですが、やり方がわからず困っています。

　　　　A 　　　　　 B 　　 　　　　 C　
1　　　　　　　(Q1)年齢
2　　　1　　　　　20代
3　　　2　　　　　30代
4　　　3　　　　　40代
5　　　4　　　　　50代
6　　
7　　　　　　　　(Q2)職業
8　　　1　　　　会社員
9　　　2　　　　自営業
10　　3　　　　　学生

以上の表を以下のように並べ替えたいのですが、
どのような関数を設定すればよいかわからず、困っています。

　　　　A 　　　　 　B 　　 　　　　C　 　　　　D
1　　　　　　　　Q1.年齢 　　Q2.職業
2　　　1　　　　　20代　　　　会社員　
3　　　2　　　　　30代　　　　自営業
4　　　3　　　　　40代　　　　学生
5　　　4　　　　　50代

どなたかお知恵を拝借できないでしょうか。
よろしくお願いいたします。

当方、Windows7でExcel2010です。

回答No.1

tom04 · ベストアンサー

こんにちは！

お望みの関数ではありません。

関数で何とかできるかもしれませんが、
手っ取り早くVBAでやってみました。

規則性としては
B列に「Q]という文字がある行からA列の空白セルの一つ前までを一つの塊りとしています。

↓の画像のようにSheet1のデータをSheet2に表示するようにしています。

Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面のカーソルが点滅しているところに
↓のコードをコピー＆ペースト　→　Excel画面に戻りマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() 'この行から
Dim i As Long, cnt As Long, myRow As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.Clear
With Worksheets("Sheet1")
For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
If InStr(StrConv(.Cells(i, "B"), vbNarrow), "Q") > 0 Then
myRow = i + 1
Do While .Cells(myRow, "A") <> ""
myRow = myRow + 1
Loop
cnt = cnt + 1
Range(.Cells(i, "A"), .Cells(myRow - 1, "B")).Copy wS.Cells(1, 2 * cnt - 1)
i = myRow
End If
Next i
wS.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
wS.Columns.AutoFit
End With
End Sub 'この行まで

※　関数でないので
データ変更があるたびにマクロを実行する必要があります。m(_ _)m

お礼

ご回答ありがとうございました。
本件については解決しましたが、別件で困っていることがありますので
別途質問をあげさせていただきます。<m(__)m>

回答No.2

bunjii

>当方、Windows7でExcel2010です。
C2に次の数式を設定して下へコピーしてください。
=IFERROR(VLOOKUP(A5,A$8:B$12,2,FALSE)&"","")
但し、この数式は提示された模擬データの範囲のみを対象にしていますので実際のデータに合わせて検索範囲を変更してください。
尚、A列の番号に重複が無いものとします。
VLOOKUP関数で検索値が見付からないときはエラーになりますのでIFERROR関数でエラーのときに空欄にします。
また、A列の検索で検出できたときに同じ行のBセルが未入力では数値の0が返りますのでこれを空欄にするため返り値&""とすることで空欄になるよう配慮しています。