|
別シート(仮にSheet2)に集計結果を出すとして
Sub 集計()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Rows(1).Insert xlShiftDown
Range("A1:C1").Value = Array("商品", "氏名", "個数")
Range("AA1").Value = "商品名,販売先氏名"
With Range("A2", Range("A65536").End(xlUp)).Offset(, 26)
Ad1 = "Sheet1!" & .Address
Ad2 = "Sheet1!" & .Offset(, -24).Address
.Formula = "=$A2&"",""&$B2"
.Copy
.PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
With Sheets("Sheet2")
.Range("A:C").ClearContents
Range("AA1", Range("AA65536").End(xlUp)).AdvancedFilter _
xlFilterCopy, , .Range("A1"), True
.Range("C1").Value = "販売個数計"
With .Range("C2", .Range("A1").End(xlDown).Offset(, 2))
.Formula = "=SUMIF(" & Ad1 & ",$A2," & Ad2 & ")"
.Copy
.PasteSpecial xlPasteValues
End With
.Range("A:A").TextToColumns DataType:=xlDelimited, Comma:=True
.Range("A1").CurrentRegion.Sort Key1:=.Range("A1"), _
Order1:=xlAscending, Header:=xlYes, Orientation:=xlSortColumns
End With
Range("AA:AA").ClearContents
Rows(1).Delete xlShiftUp
Sheets("Sheet2").Activate
With Application
.CutCopyMode = False
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
集計対象シートを開いて実行して下さい。
なお1行目は、仮の項目を入れて最後に削除してます。表を作るなら項目を入れる
のがExcelの常識ですけどね。
|
|