エクセルの表をさらにマトリクス表に展開したい。

質問

初めて質問させて頂きます。
仕事上でエクセル2003を使用しています。

以下の作業を簡単にできるように、数式またはマクロを組むことを考えています。

表１を表２のように展開する。（例）

表１
　　　A　　B　　C
１　 A１　B1　あいうえお
２　 A2　B2　かきくけこ
３　 A3　B1　さしすせそ
４　 A4　B2　たちつてと
５　 A1 B1 なにぬねの

表２
　　　A　　　　B　　　　　　　C　　
１ 　　　　　 B1 　　　　　B2
２　 A1 あいうえお
　　　　　なにぬねの
３ 　A2　　　　　　　　　かきくけこ　
４ 　A3 さしすせそ　
５ 　A4　　　　　　　　　たちつてと

※行の数は実際はもっと多いです。
　また表２のB2に記入してある内容は　 複数行になっても構いません。

まずはマクロ（VBA）を使わずにできるかやってみましたが、
VLOOKUPなどでは、なかなかうまくいきません。

よい方法はないでしょうか？
VBA使用でもかまいません。

ヒントだけでもぜひよろしくお願いします。

回答No.2

KURUMITO · ベストアンサー

関数で対応する方法です。式が複雑になりますので作業列を作って対応します。作業列は目障りでしたら最後にそのれの列を非表示にすればよいでしょう。
表1はシート1に有ってＡ、Ｂ、Ｃ列の2行目から下方にデータが入力されているとします。
結果の表はシート2に表示させることにしてＡ列のＡ1、Ａ2、・・や2行目のＢ１、Ｂ２、・・・などは自動でシート2に表示できるようにします。また、Ａ1－Ｂ1の組み合わせでは一つのセルに2行の文字列を書くことはやめて行を増やして並べて表示させるようにします。
シート1での作業列ですがＤ2セルには次の式を入力いて下方にオートフィルドラッグします。

=IF(A2="","",IF(COUNTIF(A$2:A2,A2)=1,COUNTIF(A:A,A2)+MAX(D$1:D1),""))

Ｅ2セルには次の式を入力して下方にオートフィルドラッグします。

=IF(B2="","",IF(COUNTIF(B$2:B2,B2)=1,MAX(E$1:E1)+1,""))

Ｆ2セルには次の式を入力して下方にオートフィルドラッグします。

=IF(A2="","",A2&B2&"/"&(COUNTIF(F$1:F1,A2&B2&"*")+1))

シート2では次のようにします。

Ａ3セルには次の式を入力して下方にオートフィルドラッグします。

=IF(ROW(A1)>MAX(Sheet1!D:D),"",IF(ROW(A1)=1,Sheet1!A$2,IF(COUNTIF(Sheet1!D:D,ROW(A1)),INDEX(Sheet1!A:A,MATCH(ROW(A1),Sheet1!D:D,0)),A2)))

Ｂ2セルには次の式を入力して横方向にオートフィルドラッグします。

=IF(COLUMN(A1)>MAX(Sheet1!$E:$E),"",INDEX(Sheet1!$B:$B,MATCH(COLUMN(A1),Sheet1!$E:$E,0)))

Ｂ3セルには次の式を入力して右横方向にオートフィルドラッグしたのちに下方にもオートフィルドラッグします。

=IF(OR(B$2="",$A3=""),"",IF(ISERROR(INDEX(Sheet1!$C:$C,MATCH($A3&B$2&"/"&COUNTIF($A$3:$A3,$A3),Sheet1!$F:$F,0))),"",INDEX(Sheet1!$C:$C,MATCH($A3&B$2&"/"&COUNTIF($A$3:$A3,$A3),Sheet1!$F:$F,0))))

回答No.1

keithin

関数ではうまく出来ないので、マクロにやらせるのが適当です。

ご質問の状況設定がイマイチ曖昧ですが、表２の縦項目（A1,A2…）や横項目(B1,B2…）について
○そもそもどういった項目が表１に存在するのか、調査することからはじめたい
○表２の縦横項目は所定の順序で「作成済み」であり、その表の中を埋めるだけのマクロが欲しい

ご質問の提示をみると後者であると読めますが、もし前者からマクロでやらせたいのでしたら、縦項目横項目を作表するマクロについて別途ご質問を投稿して頂いたほうがよいと思います。

前置きが長くなりましたが、こんな具合でしょうか。
表１はシート１のＡＢＣ列に並んでいるとして
表１はタイトル行など用意せずいきなり１行目から実データを並べているとして
表２はシート２のＡ１を左上コーナとして配置済みだとして

sub macro1()
　dim r as long
　dim c as long
　dim i as long

　on error resume next
　worksheets("Sheet1").select
　with worksheets("Sheet2")
　.cells.clearcontents

　for i = 1 to range("A65536").end(xlup).row
　if application.countif(.range("A:A"), cells(i, "A")) > 0 then
　　r = application.match(cells(i, "A"), .range("A:A"), 0)
　else
　　r = .range("A65536").end(xlup).row + 1
　　.cells(r, "A").value = cells(i, "A").value
　end if

　if application.countif(.range("1:1"), cells(i, "B")) > 0 then
　　c = application.match(cells(i, "B"), .range("1:1"), 0)
　else
　　c = .range("IV1").end(xltoleft).column + 1
　　.cells(1, c).value = cells(i, "B").value
　end if

　　.cells(r, c) = iif(.cells(r, c) = "" , "", .cells(r, c) & vblf) & cells(i, "C")
　next i
　end with
end sub

お礼

内容の説明不足でありながら、
自分のやりたい結果がうまく表示されました。

実際にはもっともっと複雑な表なので、
参考にさせていただき、改良して使用したいと思います。

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