[[20120921172512]]　『マトリクスのデータをテーブル形式で抽出できない』（経理人）　ページの最後に飛ぶ

『マトリクスのデータをテーブル形式で抽出できないでしょうか』（経理人）

現在、エクセルのマトリクス表をテーブルに変換する作業が必要となっており、
私の知識では対応できないため、皆様のお知恵をお借りできないでしょうか。

【イメージ】

(基データ)
　ABC
1 121
2 222
3 32

　　↓↓↓
（変換後）
A1　1
A2　2
A3　3
B1　2
B2　2
B3　2
C1　1
C2　2
C3　

※実際には、行・列とも1000近くあります。

良い方法がありましたら、ぜひご教示ください。

[エクセルのバージョン]
Excel2007

[OSのバージョン]
WindowsXP

 マクロになってしまいますけれど、
 こんな感じでどうでしょうか。

 うまくいかない（範囲が正しくなさそう）場合は
    srcTable = ActiveSheet.UsedRange
 を
    srcTable = Selection
 にして、変換したい範囲を選択して実行してみてください。
 (Mook)

 Sub Sample()
    Dim srcTable
    srcTable = ActiveSheet.UsedRange

    Dim dstTable()
    ReDim dstTable(1 To UBound(srcTable, 1) * UBound(srcTable, 2), 1 To 1)

    Dim r As Long, c As Long, rr As Long
    rr = 1
    For r = 1 To UBound(srcTable, 1)
        For c = 1 To UBound(srcTable, 2)
            dstTable(rr, 1) = srcTable(r, c)
            rr = rr + 1
        Next
    Next
    Worksheets.Add before:=Worksheets(1)
    Worksheets(1).Range("A1").Resize(UBound(srcTable, 1) * UBound(srcTable, 2), 1) = dstTable
 End Sub

早速のご教示ありがとうございます！
試してみました。
おかげさまで、徹夜せずに済みそうです。。。＞＜
本当にありがとうございました！！

 あら、単なる並べ替えと思っていましたが、
 例示を見直すとちょっと違っているようですね。

 テーブルの構成を変更することで対応はできると思いますが、
 問題は解決したでしょうか？

 表は必ずしも矩形ではないのでしょうか。
 また1列目には元のセルアドレスがくるのでしょうか。

 修正が必要な場合は、このあたり説明いただければと思います。
 (Mook)

お世話になります。

空欄を含めてテーブル化できれば、空欄部分はフィルタで対応できますので大丈夫です。
例が分かりづらく申し訳ありません、行列のIDを一列目に引用できるとなお良いのですが。

【イメージ】
(基データ) ※一列目、一行目はそれぞれエクセルの行列です。

 　　ＡＢＣ
     ⅰⅱⅲ 
1 a　１２１ 
2 b　２２２ 
3 c　３２
　　↓↓↓ 
（変換後） 
A1　aⅰ　１
A2　bⅰ　２
A3　cⅰ　３
B1　aⅱ　２
B2　bⅱ　２
B3　cⅱ　２
C1　aⅲ　１
C2　bⅲ　２
C3  cⅲ

今後、同様の作業が何度も発生しそうなので、可能であればご教示ください。

 実際の表が把握できないのですけれど、
	A	B	C	D
 1		ⅰ	ⅱ	ⅲ 
 2	a	１	２	１ 
 3	b	２	２	２ 
 4	c	３	２

 と
	A	B	C
 1	１	２	１ 
 2	２	２	２ 
 3	３	２
 のどちらでしょうか。
 とりあえず、前者と仮定しての例です。
 (Mook)

 Sub Sample2()
    Dim lastRow As Long
    Dim lastCol As Long
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    lastCol = Cells(1, Columns.Count).End(xlToLeft).Column

    Dim srcWS As Worksheet
    Set srcWS = ActiveSheet

    Worksheets.Add before:=Worksheets(1)
    Dim dstWS As Worksheet
    Set dstWS = Worksheets(1)

    Dim r As Long, c As Long, rr As Long
    rr = 1
    For c = 2 To lastCol
        For r = 2 To lastRow
            dstWS.Cells(rr, "A").Value = srcWS.Cells(r, c).AddressLocal(False, False)
            dstWS.Cells(rr, "B").Value = srcWS.Cells(r, 1).Value & srcWS.Cells(1, c).Value
            dstWS.Cells(rr, "C").Value = srcWS.Cells(r, c).Value
            rr = rr + 1
        Next
    Next
 End Sub

出張により、お礼が遅れてしまい失礼いたしました。
いただいたマクロにより、欲しいデータを即座に作成することができ、大変助かりました。
どうもありがとうございました。

（経理人）

コメント返信：

[ 一覧(最新更新順) ]

[[20120921172512]] 『マトリクスのデータをテーブル形式で抽出できない』（経理人） ページの最後に飛ぶ

[[20120921172512]]　『マトリクスのデータをテーブル形式で抽出できない』（経理人）　ページの最後に飛ぶ