【エクセル】縦に続いた表を横にして整理したい

質問

表題の通りですが、エクセル2003で、以下のようなことがしたいです。
[元データ]
　　A　　　　 B　　　　 　
1　 氏名　　　田中
2　 住所　　　東京
3　 電話番号　＊＊＊
4　 登録日　　＊＊＊
5
6　 氏名　　　鈴木
7　 住所　　　埼玉
8　 電話番号　＊＊＊
9　 登録日　　＊＊＊
10
11　 氏名　　　佐藤
12 　住所　　　埼玉
13　 電話番号　＊＊＊
14　
15 氏名　　　工藤

のように一人分のデータが、空白セル1マス空けて、延々と続いた様な表があります（3万行くらい）。
これを下記のように変更したいのです
[整理後]
　　A　　　　B　　　　C　　　　D　　　　E
1　氏名　　　住所　　　電話番号　　登録日
1　田中　　　東京　　　＊＊＊　　　＊＊＊
2　鈴木　　　埼玉　　　＊＊＊　　　＊＊＊
3　佐藤　　　埼玉　　　＊＊＊　　　（空白）
4　工藤　　　
5

のような感じです。

3つ目の佐藤氏のデータのように元データに登録日という項目が無い場合があります。
それ以外の項目に関して順番や有無の違いはありません、１データの最終行にある登録日という
項目だけ有ったり無かったりします。

項目だけは縦のものを横に貼り付け、で出来たのですが、それが意外のデータを効率よく移すには
どうしたら良いでしょうか。

関数、マクロを教えていただけたらありがたいです。こうしたら良いというアイデアだけでも助かります。どうか宜しくお願いします。
（説明不足のところがありましたらすいません…補足致します）

回答No.2

noah7150 · ベストアンサー

VBAのサンプル。
理解できればですが・・・

Sub Macro1()
Dim iWS As Worksheet
Dim oWS As Worksheet
Dim iRow As Long
Dim oRow As Long
Dim iPos As Long

iRow = 1
oRow = 2
iPos = 0
Set iWS = ActiveWorkbook.Sheets(1)
Set oWS = ActiveWorkbook.Sheets(2)

Do While iWS.Cells(iRow + iPos, 1) <> ""
If iWS.Cells(iRow + iPos, 1) <> "氏名" Then
MsgBox "カラム異常 行=[" & iRow + iPos & "] 内容=[" & iWS.Cells(iRow + iPos, 1) & "]"
End If
While iWS.Cells(iRow + iPos, 1) <> ""
Select Case iWS.Cells(iRow + iPos, 1)
Case "氏名"
oWS.Cells(oRow, 1) = iWS.Cells(iRow + iPos, 2)
Case "住所"
oWS.Cells(oRow, 2) = iWS.Cells(iRow + iPos, 2)
Case "電話番号"
oWS.Cells(oRow, 3) = iWS.Cells(iRow + iPos, 2)
Case "登録日"
oWS.Cells(oRow, 4) = iWS.Cells(iRow + iPos, 2)
Case Else
MsgBox "カラム異常 行=[" & iRow + iPos & "] 内容=[" & iWS.Cells(iRow + iPos, 1) & "]"
End Select
iPos = iPos + 1
Wend
iRow = iRow + iPos + 1
iPos = 0
oRow = oRow + 1
Loop
Set iWS = Nothing
Set oWS = Nothing
End Sub

補足

ありがとうございます。VBAはまだ初心者なのですが。
教えていただいたプログラムで出来ました。

ただ説明不足で申し訳ありません。各データを区切る空白の行が
１行だけではなく、２行の場合も存在するのです。３行はありま
せんでした。
この場合どうすれば良いでしょうか。

回答No.5

noname#204879

Sheet1
　　　 A　　　　　B　　　 C
1　 氏名　　　田中　　　　 1
2　 住所　　　東京
3　 電話番号　01-23-4567
4　 登録日　　2008/01/23
5
6
7　 氏名　　　鈴木　　　　 7
8　 住所　　　埼玉
9　 電話番号　02-34-5678
10　登録日　　2007/08/09
11
12　氏名　　　佐藤　　　　12
13　住所　　　埼玉
14　電話番号　03-45-6789
15
16　氏名　　　工藤　　　　16

１．Sheet1 の空き列（此処ではＣ列とする）の１行目に次式を入力し
　　て、此れを下方にズズーッとドラッグ＆ペースト
　　=IF(A1="氏名",ROW(),"")

Sheet2
　　A　　 B　　　　C　　　　　 D
1　氏名　住所　電話番号　　登録日
2　田中　東京　01-23-4567　2008/01/23
3　鈴木　埼玉　02-34-5678　2007/08/09
4　佐藤　埼玉　03-45-6789
5　工藤
6

以下は Sheet2 における操作です。
２．セル A2 に次の[条件付き書式]を設定
　　　　数式が　　　　=ISERROR(A2)
　　　　フォント色　　白
３．セル A2 に次式を入力して、此れを右方にズズーッとドラッグ＆ペ
　　ースト
　　=IF(OFFSET(INDIRECT("Sheet1!"&ADDRESS(SMALL(Sheet1!$C:$C,ROW(A1)),1)),COLUMN(A1)-1,1)=0,"",OFFSET(INDIRECT("Sheet1!"&ADDRESS(SMALL(Sheet1!$C:$C,ROW(A1)),1)),COLUMN(A1)-1,1))
４．セル D2 を yyyy/mm/dd に書式設定
５．範囲 A2:D2 を下方にズズーッとドラッグ＆ペースト

お礼

丁寧に教えて頂き、ありがとうございました。

参考にさせていただきます。

回答No.4

imogasi

1人あて４行（空白行も入れて５行）ばかりなら、作業列を使わず行の計算だけで出来ます。
氏名は　=INDEX($A$1:$B$100,(ROW()-1)*5+1,2)
しかし補足で、どうもソウでないらしい（大事なことだから、質問に初めからしっかり書いておくこと）からこの方法は使えない。
ーーーーーー
例データ（空白行数イレギュラーの場合）
第１行目は空白行にする。（データを入れない）
A2:B100の一部
氏名 田中 1
住所 東京
電話番号 ＊＊＊
登録日 ＊＊＊
ーーー　－－－ <===空白行の代わりの表示
ーーー　－－－
氏名 鈴木 2
住所 埼玉
電話番号 ＆＆＆
登録日 ＊＊＊
ーーー　－－－
ーーー　－－－
ーーー　－－－
氏名 木村 3
住所 神奈川
電話番号 ーーー
C列は　=IF(A2="氏名",MAX($C$1:C1)+1,"")
下方向に式を複写
結果
氏名に連番を振っている。
F2に
=INDEX($A$1:$B$100,MATCH(ROW()-1,$C$1:$C$100,0),2)
G2に
=INDEX($A$1:$B$100,MATCH(ROW()-1,$C$1:$C$100,0)+1,2)
H2に
=INDEX($A$1:$B$100,MATCH(ROW()-1,$C$1:$C$100,0)+2,2)
下方向に式を複写
結果　F2:H4
田中 東京 ＊＊＊
鈴木 埼玉 ＆＆＆
木村 神奈川 ーーー
上記は抜き出し問題で私が回答している手法の「imogasi方式」（Googleで照会のこと）と同じ手法で出来た。
ーー
もしA列の氏名が当てにならないなら、上記C列ｎ式の変わりに
=IF(AND(A1="",A2<>""),MAX($D$1:D1)+1,"")　なら使えるだろう。
塊で最終空白行の次行を氏名行とするという意味である。

お礼

丁寧に教えてもらい、ありがとうございました。

参考にさせていただきます。

回答No.3

mt2008

No.1です。
条件は正確に書いてください。
A3に入れる式を↓に換えればいけるはずです。
=IF(D3="","",IF(A2="",MAX(A$1:A2)+1,A2))

お礼

返事大変遅くなりました。。

出来ました、ありがとうございました。

回答No.1

mt2008

各データが誰のデータなのかを管理する情報があれば出来ると思います。
私でしたら、次の様にします。
先頭に作業列を2列追加します（A,B列を追加）。
A1とA2に　1
A3に　=IF(D3="","",IF(D2="",A1+1,A2))　と入れて下までコピー。

これでA列が個人No.になり、誰のデータなのか特定できます。
次にB列を作業列として使います。

B1に　=A1&C1　と入れて下までコピー
これで、「1住所」の様に個人No.データの項目名が１つになった情報ができました。これをVlookupで整理します。

F～J列を使うとして説明します。
G1～J1に「氏名」「住所」「電話番号」「登録日」と、データの項目名と同じ物を入力します。
そしてF2に　1
G2に　=IF(ISNA(VLOOKUP($F2&G$1,$B:$D,3,FALSE)),"",VLOOKUP($F2&G$1,$B:$D,3,FALSE)) 　と、入れてJ2までコピー

最後に、F2:J2を下までコピー。

コレでいかがでしょう。

補足

ありがとうございます。出来ました。
ただ説明不足で申し訳ないです。各データの区切りの空白行が
２行になっている場合もありました。。
３行はありません1行か2行になります。。すいませんがこの場合も
教えていただけないでしょうか。