エクセルＶＢＡによるマトリクス表の縦配列

質問

エクセルＶＢＡで以下のような処理を行うプログラムを作成したいのですが、
シロウトなんで、なかなかスマートに作れません。
どのようにすればいいかご教示いただけたら有り難いです。

(1)下記のように、縦横のマトリクス表にデータが入力されている。

　 A B C ・・
1
2
3
・
・

(2)これを別シートに縦に２列にデータを並べるように処理する。
　左列には"列項目＆行項目"、右列には該当するデータをセットする。

A1　　A1のデータ
A2　　A2のデータ　
A3　　A3のデータ
・　　　・
B1　　B1のデータ
・　　　・
・　　　・

(3)尚、列項目（A.B.C...）と行項目（1.2.3...）の項目数は不定で、セルが空白になるまで、
処理を繰り返すかたちにする。

以上のような条件ですが、よろしくお願い致します。

回答No.2

Wendy02 · ベストアンサー

こんばんは。

＞(2)これを別シートに縦に２列にデータを並べるように処理する。
＞　左列には"列項目＆行項目"、右列には該当するデータをセットする。

そうしたら、事実上、データは1列ではありませんか？

＞左列には"列項目＆行項目"　
＞A1　　A1のデータ

単に、アドレスのことではありませんか？
列項目&行項目として、例が挙げれている内容とは違うのでしたら、ご指摘ください。
もし、項目として別にあるのでしたら、データの左端上の部分のデータはないことになりますね。

＞列項目（A.B.C...）と行項目（1.2.3...）の項目数は不定で、セルが空白になるまで、

よく意味がわかりません。マトリックスで取得したら、もし、項目が別にあるのなら左端上の空白以外には、空白セルはないことになりますが、データの中間地で空白があったら、そこでデータの取得は終わりだということですか？

とりあえず、一旦、マトリックスで取得して、2次元配列で、アドレスと値を入れなおして、その配列を、別のシートに貼り付けるという方法です。256*256 以上のデータは取得しても、2列のセルには入りません。

アドレスを入れるところで、時間的なロスが生じています。数値からアドレスに変換するのは、面倒なので、そのままセルにアクセスしてしまいました。

'<標準モジュール>
Sub Matrix2Vertical()
Dim ArBuf As Variant, myArray As Variant, MaxNum As Long
Dim j As Long, i As Long, k As Long, Sh2 As Worksheet

'===設定:移し変えるシート================
Set Sh2 = Worksheets("Sheet2")
'=======================================
With Range("A1").CurrentRegion
　If .Count = 1 Then _
　MsgBox "データがありません。", vbInformation: Exit Sub
　MaxNum = Application.Min(.Count, Rows.Count)
　ArBuf = .Value
　ReDim myArray(.Count - 1, 1)
'2次元配列を入れなおし
For j = LBound(ArBuf, 2) To UBound(ArBuf, 2)
　For i = LBound(ArBuf, 1) To UBound(ArBuf, 1)
　　myArray(k, 0) = Cells(i, j).Address(0, 0)
　　myArray(k, 1) = ArBuf(i, j)
　　k = k + 1
　Next i
　　If k > MaxNum Then Exit For　'多少のズレはあっても問題ないはず
Next j
End With
　 Application.ScreenUpdating = False
　　　Sh2.Range("A1").Resize(MaxNum, 2).Value = myArray
　 Application.ScreenUpdating = True
　 Set Sh2 = Nothing
　 Beep
End Sub

お礼

ご丁寧にありがとうございました。
本当に助かりました！

なんとか自分でやろうと、一日やってましたが、
少しずつみえてきました。ご教示頂いた内容を参考に
させていただくと、おそらくできると思います。

回答No.1

haukappu

（CurrentRegionとか使って）範囲を取得してコピーした後、「形式を選択して貼り付け→行列を入れ替える」で駄目でしょうか？

お礼

ご回答ありがとうございます。
参考にさせて頂きます。