日付・項目別に数量を集計したシートを作成するには?

Question 91.2 Excel VBA Borad (掲示板)より Previous Next
はじめまして。最近VBAを初めた者です。 さっそくですが教えてください。
SHEET1                     SHEET2
Sheet1   Sheet2
上記のように、A列・B列が同じ内容のC列の数量を合計し、別シートに表示させる為にはどうしたら良いのでしょうか?

マクロはこんな感じまではできました。 しかしこれでは、全く同じ内容をコピーするだけにすぎません。 これ以上はアイデアが浮かばずにかれこれ数週間が経過してしまいました。よろしくお願いします。
    GYO = 1
    GAPPI = Range("A" & GYO).Value
    KOUMOKU = Range("B" & GYO).Value
    SURYO = Range("C" & GYO).Value
    Do Until GAPPI = ""
        Sheet2.Range("A65536").End(xlUp).Offset(1) = GAPPI
        Sheet2.Range("B65536").End(xlUp).Offset(1) = KOUMOKU
        Sheet2.Range("C65536").End(xlUp).Offset(1) = SURYO
        GYO = GYO + 1
        GAPPI = Range("A" & GYO).Value
    Loop
Answer   2008.11.9 永井善王
「これ以上はアイデアが浮かばずにかれこれ数週間」と、がんばってますね。私は今、執筆中で殆ど時間がとれませんから、アイデアだけ差し上げます。

 【図1】Sheet1・原データ      【図2】Sheet2・原データのA列に「キー」を挿入
Sheet1   Sheet2

 【図3】Sheet2・アウトライン機能で集計
Sheet1
・【図1】は、あなたのSHEET1に少々データを追加したものです。
・【図2】は、Sheet1をコピーしてからA列にキーを追加しました。
・【図3】は、Sheet2をアウトライン機能で集計した状態です。
・【図4】は、集計行と総計行だけを表示しました。
・【図5】は、アクティブセル領域をコピーした状態です。

あなたなら、貼り付けた表を SHEET2の状態にする力はあるようですから、私はしてありません。

アウトライン機能がわからない場合は「Excel 集計機能」とかでググれば解説ページがたくさん出てきます。


 【図4】Sheet2・集計行と総計行だけ表示    【図5】Sheet2・アクティブセル領域をコピー
Sheet1   Sheet1

下記はマクロ記録したものを整理しただけです。うまくできたら報告してください。何よりのお礼になります。
Sub 日別品目別の合計を別シートに表示する2()
    Sheets("Sheet1").Select
        Cells.Select
        Selection.Copy
    Sheets("Sheet2").Select
        Range("A1").Select
        ActiveSheet.Paste
        
        Columns("A:A").Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("A1").Select
        ActiveCell.FormulaR1C1 = "キー"
        Range("A2").Select
        ActiveCell.FormulaR1C1 = "=MONTH(RC[1]) & DAY(RC[1]) & RC[2]"
        Range("A2").Select
        Selection.Copy
        Range("A3:A9").Select
        ActiveSheet.Paste
        
        Range("A1").Select
        Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(4), _
            Replace:=True, PageBreaks:=False, SummaryBelowData:=True
        ActiveSheet.Outline.ShowLevels RowLevels:=3
        ActiveSheet.Outline.ShowLevels RowLevels:=2
        
    Sheets("Sheet2").Select
        Range("A1").Select
        Selection.SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
    Sheets("Sheet3").Select
        Range("A1").Select
        ActiveSheet.Paste
End Sub
本当にありがとうございました
頂いたアイデアで、早速試した結果、うまくいきました。
こちらのサイトで相談してみて本当に良かったと思っています。
これからも他に色々と作りたいプログラム等がありますので、再度、煮詰まってしまった際には、相談させて頂く事があると思いますので、お忙しい中恐縮ですが、よろしくお願いします。

 

Excel VBA Macro