| |
>３．データ→集計 でコード毎の合計値を求める。
たしかに集計機能を使うとすばやく合計が出ますが、行を追加する処理を加えるなら
これを止めて、普通に最終行からデクリメントして、値の変わるところで 2行挿入
したって変わりませんね。もちろん合計とカウントの、両方の数式か値を入れることに
なりますが。例えば A列を基準にB列を集計するコードは・・
Sub Test_集計()
Dim MyR As Range, MyR2 As Range
Dim i As Long, j As Long
Application.ScreenUpdating = False
With Sheets("Sheet2")
Sheets("Sheet1").Range("A1").CurrentRegion.Copy
.Range("A1").PasteSpecial xlValues
Application.CutCopyMode = False
.Range("A1").CurrentRegion.Sort Key1:=.Range("A1"), _
Order1:=xlAscending, Header:=xlYes, Orientation:=xlSortColumns
For i = .Range("A65536").End(xlUp).Row To 3 Step -1
If .Cells(i, 1).Value <> .Cells(i - 1, 1).Value Then
.Rows(i).Resize(2).Insert
End If
Next i
With .Range("B2", .Range("B65536").End(xlUp))
Set MyR = .SpecialCells(2, 1)
Set MyR2 = .Resize(.Cells.Count + 2) _
.SpecialCells(xlCellTypeBlanks)
End With
End With
For j = 1 To MyR.Areas.Count
With MyR2.Areas(j)
.Cells(1).Value = WorksheetFunction.Sum(MyR.Areas(j))
.Cells(2).Value = WorksheetFunction.Count(MyR.Areas(j))
.Cells(1).Offset(, -1).Value = "小計"
.Cells(2).Offset(, -1).Value = "個数"
End With
Next j
With Sheets("Sheet2").Range("B65536").End(xlUp)
.Offset(1).Value = WorksheetFunction.Sum(MyR)
.Offset(2).Value = WorksheetFunction.Count(MyR)
.Offset(1, -1).Value = "総計"
.Offset(2, -1).Value = "総個数"
End With
Application.ScreenUpdating = True
Set MyR = Nothing: Set MyR2 = Nothing
End Sub
てな感じです。1行目を項目としています。
あとはシート2枚にコピーして、それぞれ集計機能で計とカウントを出すとか。
|
|
Kein
- 03/5/23(金) 23:21 -
