Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


75510 / 76734 ←次へ | 前へ→

【5660】Re:データの集計とカウントについて
回答  Kein  - 03/5/23(金) 23:21 -

引用なし
パスワード
   >3.データ→集計 でコード毎の合計値を求める。
たしかに集計機能を使うとすばやく合計が出ますが、行を追加する処理を加えるなら
これを止めて、普通に最終行からデクリメントして、値の変わるところで 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枚にコピーして、それぞれ集計機能で計とカウントを出すとか。
0 hits

【5653】データの集計とカウントについて 若葉マーク 03/5/23(金) 18:50 質問
【5660】Re:データの集計とカウントについて Kein 03/5/23(金) 23:21 回答

75510 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free