EXCELで表をクロス形式に計算せずに表したい

質問

EXCEL2003を利用しています。

まず、写真を確認お願いいたします。SHEET1に
・Ａ列 Ｎｏ
・Ｂ列 年月日
・Ｃ列 会社
・Ｄ列 商品
の表があります。それをSHEET2で
・行タイトルで会社名
・列タイトルで年月日
の表をつくり、表のデータには、写真のように
商品を計算せずに書き出す。ということをしたいです。

これを手作業で行うのは大変なので、できればうまく簡単に出来るようにしたいです。

ピヴォットテーブルであれば、何らかの計算をしたものを楽に表示することができるのは知っているのですが、このように計算せずに簡単に表示させる方法を教えてもらえないでしょうか？

https://www.dropbox.com/s/nxsgkfgd6k9ti11/%E3%82%B3%E3%83%94%E3%83%BC%E3%81%97%E3%81%9F%E7%94%BB%E5%83%8F%20%2820140708%20170550%29.jpg

回答No.3

tom04

こんばんは！
VBAになってしまいますが一例です。

Alt+F11キー　→　メニュー　→　挿入　→　VBE画面のカーソルが点滅しているところに
↓のコードをコピー＆ペースト　→　Excel画面に戻りマクロを実行してみてください。
（Alt+F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() 'この行から
Dim i As Long, j As Long, lastRow1 As Long, lastRow2 As Long, lastCol As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
Application.ScreenUpdating = False
With Worksheets("Sheet1")
lastRow1 = .UsedRange.Rows.Count
.Range("E:E").Insert
.Range("B:B").Copy
.Range("E1").PasteSpecial Paste:=xlPasteValues
wS.Range("A:A").Insert
lastRow2 = wS.UsedRange.Rows.Count
lastCol = wS.Cells(1, Columns.Count).End(xlToLeft).Column
If lastRow2 > 1 And lastCol > 2 Then
Range(wS.Cells(2, "C"), wS.Cells(lastRow2, lastCol)).ClearContents
End If
For i = 2 To wS.Cells(Rows.Count, "B").End(xlUp).Row Step 3
For j = 3 To lastCol
.Range("A1").AutoFilter field:=3, Criteria1:=wS.Cells(i, "B")
.Range("A1").AutoFilter field:=5, Criteria1:=wS.Cells(1, j)
If .Cells(Rows.Count, "D").End(xlUp).Row > 1 Then
Range(.Cells(2, "D"), .Cells(lastRow1, "D")).SpecialCells(xlCellTypeVisible).Copy wS.Range("A1")
Range(wS.Cells(1, "A"), wS.Cells(3, "A")).Copy wS.Cells(i, j)
wS.Range("A:A").ClearContents
End If
Next j
Next i
.AutoFilterMode = False
.Range("E:E").Delete
wS.Range("A:A").Delete
Application.ScreenUpdating = True
wS.Activate
End With
End Sub 'この行まで

※　関数ではないので、Sheet1のデータ変更があるたびにマクロを実行する必要があります。m(_ _)m

回答No.2

nishi6

質問にある図で、

セルB2：
=INDEX(Sheet1!$D:$D,SMALL(IF((Sheet1!$B$2:$B$20=B$1)*(Sheet1!$C$2:$C$20=$A2),ROW(Sheet1!$D$2:$D$20),10000),MOD(ROW(A2)+1,3)+1),1)

セルB3:
=INDEX(Sheet1!$D:$D,SMALL(IF((Sheet1!$B$2:$B$20=B$1)*(Sheet1!$C$2:$C$20=$A2),ROW(Sheet1!$D$2:$D$20),10000),MOD(ROW(A3)+1,3)+1),1)

セルB4:
=INDEX(Sheet1!$D:$D,SMALL(IF((Sheet1!$B$2:$B$20=B$1)*(Sheet1!$C$2:$C$20=$A2),ROW(Sheet1!$D$2:$D$20),10000),MOD(ROW(A4)+1,3)+1),1)

いずれも配列数式です。登録するとき、CTRL+SHIFT+ENTERとしてください。10000行までは大丈夫でしょう。
上記３式よく似ていますが、A列の「A、B、C・・・」が消されているので苦肉の策で３式にしました。（$A2が動いていません）

３式をセットで横に日付分コピーした後は、「A、B、C・・・」を３行単位でコピーしてください。

もう少し短くできるかもしれませんがこの辺りで。。。

回答No.1

noname#204879

同会社で日付が重複しているデータは最大３個と決めつけて構わないの？
そういうことはキチンと書いておきませうネ！

補足

ご指摘ありがとうございます。
最大３個という条件です。