[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『集計する列を増やしたい』(さざんか)
お世話になります。
明細シートの集計結果を集計シートに行いたくて、過去ログで近いものを見つけて試してみました。
Dim v As Variant Dim dic As Object Dim c As Range Dim x As Long Set dic = CreateObject("Scripting.Dictionary") With Sheets("明細") With .Range("A2", .Range("A" & Rows.Count).End(xlUp)) ReDim v(1 To .Rows.Count, 1 To 3) For Each c In .Cells If c.Value <> "" Then If Not dic.exists(c.Value) Then dic(c.Value) = dic.Count + 1 x = dic(c.Value) v(x, 1) = c.Value v(x, 2) = c.Offset(, 1).Value v(x, 3) = v(x, 3) + c.Offset(, 2).Value End If Next End With End With With Sheets("集計") .UsedRange.Offset(3).ClearContents .Range("A4").Resize(UBound(v, 1), UBound(v, 2)).Value = v .Select End With
End Sub
上記のコードでC列までは思い通りに集計されたのですが、D列とE列にも集計結果を表示するには、どのようにコードを書き換えればよいでしょうか?
お手数をおかけして申し訳ございませんが、解決方法がございましたら、ご教示いただければ幸いです。
何卒よろしくお願い致します。
< 使用 Excel:Excel2013、使用 OS:Windows7 >
次に、配列だけ増やしても、値を計算しないと意味がありません。 例えば、3列目は以下のように合計しているようですね。
v(x, 3) = v(x, 3) + c.Offset(, 2).Value
これを応用して、4列目と5列目の計算式を追加してみてください。
(???) 2019/08/08(木) 17:06
Dim v As Variant Dim dic As Object Dim c As Range Dim x As Long Set dic = CreateObject("Scripting.Dictionary") With Sheets("明細") With .Range("A2", .Range("A" & Rows.Count).End(xlUp)) ReDim v(1 To .Rows.Count, 1 To 5) For Each c In .Cells If c.Value <> "" Then If Not dic.exists(c.Value) Then dic(c.Value) = dic.Count + 1 x = dic(c.Value) v(x, 1) = c.Value v(x, 2) = c.Offset(, 1).Value v(x, 3) = v(x, 3) + c.Offset(, 2).Value v(x, 4) = v(x, 4) + c.Offset(, 3).Value v(x, 5) = v(x, 5) + c.Offset(, 4).Value End If Next End With End With With Sheets("集計") .UsedRange.Offset(3).ClearContents .Range("A4").Resize(UBound(v, 1), UBound(v, 2)).Value = v .Select End With
End Sub
回答を参考にさせていただき、上記コードでうまく動作致しました。
(さざんか) 2019/08/08(木) 18:01
【明細】
____A__________B_______C_____D_____E_____ 1 商品コード 商品名 件数 個数 金額 2 1111 商品A 2 10 10000 3 2222 商品B 5 7 6000 4 3333 商品C 3 8 9000 5 1111 商品A 11 22 12000 6 2222 商品B 7 8 8000
↓
【集計の結果】
____A__________B_______C_____D_____E_____ 1 2 タイトル 3 商品コード 商品名 件数 個数 金額 4 1111 商品A 13 32 22000 5 2222 商品B 12 15 16000 6 3333 商品C 3 8 9000
Sub 別アプローチ() Dim MyRNG As Range Dim tmp As Long
Set MyRNG = Worksheets("明細").Range("A1").CurrentRegion
With Worksheets("集計の結果") MyRNG.Copy .Range("A3")
.Range("A3").Resize(MyRNG.Rows.Count, MyRNG.Columns.Count).RemoveDuplicates _ Columns:=Array(1, 2), Header:=xlYes
tmp = .Cells(.Rows.Count, "A").End(xlUp).Row - 3
With .Range("C4").Resize(tmp, 3) .Formula = "=SUMIFS(明細!C:C,明細!$A:$A,$A4,明細!$B:$B,$B4)" End With End With
End Sub
(もこな2) 2019/08/09(金) 02:49
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.