Excel 集計表の作成

質問

Excelの集計表の作成について教えてください。

Accessから出力したデータ（日別、作業別、その件数）の一覧表を作りたいと思っています。
今のところ、このような状態になっています
↓↓
　 　　 A 　　　B　　　　C 　　　
1 　 日付　　作業名　　件数

2 　1日 　 作業A　　　　　100

3　　1日 　　作業B 　 　100

4 　 2日 　作業A 　　100

コレをこのような状態に変えたいんです
↓↓
　 　 A 　　　　 B 　　　 　 C　　　　　　D
1 　日付　　　作業A　　作業B　　作業D

2　1日　　　　100　　　100　　　　50

3　2日　　　　100　　　100　　　　50

（行→日にち　　列→作業名）

ボタン１つで出来るようにしたいのでマクロ、VBAを使用したいです。
どなたかお知恵を貸していただけないでしょうか。

回答No.2

pkh4989 · ベストアンサー

こんにちは。

以下のマクロで、お試しください。
データシートをActiveにしてください。
1行が見出し、A列の日付は日付順にソートされているとして、結果は「Sheet2」へ展開されます。

Const MAXCOL　　　　As Integer = 256
Type rWORK
　　NM　　　　　　 As String
End Type
Dim tWORK()　　　　 As rWORK
Dim WorkCnt　　　　 As Integer
'
Type rDATE
　　NM　　　　　　 As String
　　CNT(MAXCOL)　　 As Long
End Type
Dim tDATE()　　　　 As rDATE
Dim DateCnt　　　　 As Integer
'
Sub 集計表()
　　Dim wR　　 As Long
　　Dim wC　　 As Integer
　　Dim ckDate As String
　　Dim wI　　 As Integer
　　Dim xI　　 As Integer
　　Dim c　　 As Range
　　Dim eFlg　　As Boolean
　　Dim wsht2 As Worksheet
　　'
　　Application.ScreenUpdating = False
　　Set wsht2 = Worksheets("Sheet2")
　　Erase tDATE, tWORK
　　ckDate = "": DateCnt = 0: WorkCnt = 0
　　'
　　With ActiveSheet
　　　　wR = .Range("A" & Rows.Count).End(xlUp).Row
　　　　For Each c In .Range("A2:A" & wR)
　　　　　　'日付チェック及び設定
　　　　　　If ckDate <> c.Value Then
　　　　　　　　ckDate = c.Value
　　　　　　　　DateCnt = DateCnt + 1
　　　　　　　　ReDim Preserve tDATE(DateCnt)
　　　　　　　　tDATE(DateCnt).NM = c.Value
　　　　　　End If
　　　　　　'
　　　　　　'作業名チェック及び設定
　　　　　　eFlg = False
　　　　　　For wI = 1 To WorkCnt
　　　　　　　　If tWORK(wI).NM = c.Offset(0, 1) Then
　　　　　　　　　　tDATE(DateCnt).CNT(wI) = c.Offset(0, 2)
　　　　　　　　　　eFlg = True
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next
　　　　　　If eFlg = False Then
　　　　　　　　WorkCnt = WorkCnt + 1
　　　　　　　　ReDim Preserve tWORK(WorkCnt)
　　　　　　　　tWORK(WorkCnt).NM = c.Offset(0, 1)
　　　　　　　　tDATE(DateCnt).CNT(WorkCnt) = c.Offset(0, 2)
　　　　　　End If
　　　　Next
　　　　'
　　　　'展開
　　　　wsht2.Cells(1, 1) = "日付"
　　　　For xI = 1 To WorkCnt
　　　　　　wsht2.Cells(1, xI + 1) = tWORK(xI).NM
　　　　Next
　　　　wR = 1
　　　　For wI = 1 To DateCnt
　　　　　　wR = wR + 1
　　　　　　wsht2.Cells(wR, 1) = tDATE(wI).NM
　　　　　　wC = 1
　　　　　　For xI = 1 To WorkCnt
　　　　　　　　wC = wC + 1
　　　　　　　　If tDATE(wI).CNT(xI) > 0 Then
　　　　　　　　　　wsht2.Cells(wR, wC) = tDATE(wI).CNT(xI)
　　　　　　　　End If
　　　　　　Next
　　　　Next
　　End With
　　Application.ScreenUpdating = True
End Sub

お礼

回答ありがとうございます。
かなり複雑そうですね。　とにかく試してみます。

回答No.1

don9don9

ピボットテーブルではダメなんですか？

お礼

回答ありがとうございます。
ピボットテーブルは最初に考えたんですけど、表の様式が既に決まっており、ピボットテーブルで作成すると更に様式変更の作業が発生するためできません。