縦に並んでいる表をマクロで横に並び替えたい。

質問

以下のような縦に並んだ表を、
（A列には、日付/NO、B列には文字列が入力されています。）
　　 A　　　　　　B　
-------------
1 │ 10月1日　　
2 │NO　　　　　
3 │1　　　　　　A
4 │2　　　　　　B
5 │3　　　　　　C
6 │10月2日
7 │NO
8 │1　　　　　　D
9 │2　　　　　　E
10│3　　　　　 F
11│4　　　　　　G
12│5　　　　　　H
13│10月3日
14│1　　　　　　　I
15│2　　　　　　 J
16│10月4日
17│・　　　　　　・
18│・　　　　　　・
19│・　　　　　　・
20│・　　　　　　・

以下のように横に並び替えたい。

　　 A　　　　　　B　　　　C　　　　　D　　　　E　　　　　F 　　　　G
-----------------------------------------------------------------
1 │ 10月1日　　　　　10月2日　　　　　　10月3日　　　　　　10月4日　・・・・　　
2 │NO　　　　　　　 　NO　　　　　　　 　　NO　　　　　　　 　　NO 　　　　　
3 │1　　　　　　A　　　1　　　　　　D　　　　1　　　　　　I
4 │2　　　　　　B　　　2　　　　　　E　　　　2　　　　　　J
5 │3　　　　　　C　　　3　　　　　　F
6 │　　　　　　　　　　　4　　　　　　G
7 │　　　　　　　　　　　5　　　　　　H
8 │　　　　　
9 │

日付ごとに項目数が異なるので、
どのようにマクロを組めばいいのか分からず困っております。。

ご回答よろしくお願い致します＞＜！

回答No.2

soixante · ベストアンサー

すんごい不細工ですが突貫で書いてみました。いちおう動作確認済みです。

Sub aaa()
Dim i As Long, Strow As Long, Edrow As Long
Dim LstCol As Long, LstRow As Long
Dim Rng As Range

i = 1

Do While Cells(i, 1).Value <> ""
If TypeName(Cells(i, 1).Value) = "Date" Then
Cells(i, 3).Value = 1
End If
i = i + 1
Loop
LstRow = Cells(Rows.Count, 1).End(xlUp).Row
Cells(LstRow + 1, 3).Value = 1

Do
Strow = Cells(1, 3).End(xlDown).Row
Edrow = Cells(Strow, 3).End(xlDown).Row - 1
Set Rng = Range(Cells(Strow, 1), Cells(Edrow, 3))
LstCol = Cells(1, Columns.Count).End(xlToLeft).Column + 1

Rng.Cut Cells(1, LstCol)
If Cells(Rows.Count, 1).End(xlUp).Row <> LstRow Then Exit Do
Loop

LstCol = Cells(1, Columns.Count).End(xlToLeft).Column
For i = LstCol To 3 Step -1
If Cells(1, i).Value = 1 Then
Columns(i).Delete
End If
Next i

Set Rng = Nothing
End Sub

3列目に日付のフラグを立ててます。
それで上から順に切り取り、貼り付けを繰り返す、という手作業イメージを
イメージした動きで。

お礼

すぐのご回答本当にありがとうございます！
うまくできそうです(連桁付き8分音符)

回答No.1

CC_T

ベタに処理するなら、別のシートへのコピーで処理していけば良いでしょう。
Ａ列に日付が入ったセルのＢ列は空白でしょうから、各日付ごとに分けるのにそれが利用できるでしょうね。

別シートへの書き込みを、
sheet2!cells(YY,XX)=sheet1cells(Y,X)
としてやるような形。

データのシートでＢ列を上から見ていって、空白ならＡ列が日付かを判定させる。　
※例えば日付欄が日付形式のデータならその値が2012/4/1の41000以上かどうか、などで判定出来る。
Ａ列が日付ならXX=XX＋２、ＹＹ＝1。日付でないならYY=YY＋１。
元データ行のＡ列をセル（YY,XX）に入れ、Ｂ列のセル内容をセル（XX+1,YY)に書き込む。

以上、Ａ列が空白でない限りYを１つづつ増やしながら繰り返す。

要は、Ａ列が日付だったら次にＡ列に日付がくるまでを下に入れていき、Ａ列が日付だったら記入列を右に２列ずらして１行目に戻って続ける、ということです。

お礼

すぐのご回答本当にありがとうございます!!
CC_Tさんのおっしゃる通りSheet2に横の表として完成させることがベストです!!

なんとなくおっしゃっている事は分かるのですが、
本当に初心者なもので実際にどのような式や
ＶＢＡを入力すればいいのか。。

申し訳ございません。
可能であればもう少し具体的にご説明いただけないでしょうか＞＜？