サンプルではメニューの”データ” - ”集計”の機能を活用して
レベルの切り替え、アウトライン記号の非表示、表示データのコピー
などを行います。
※前提:シート上に集計可能なデータ
コマンドボタン(CmdShukei,CmdChangeLevel,CmdCopyData)
を集計時に位置がずれないように配置してください。
'=======宣言セクション========
Private rngデータ範囲 As Range
Private int列数 As Integer
Private int集計レベル As Integer
'=============================
Private Sub CmdShukei_Click()
Dim int基準列 As Integer
Dim int集計列 As Integer
Dim Ret As Integer
With ActiveSheet
'セルA1から連続するセル領域を取得
Set rngデータ範囲 = .Range("A1").CurrentRegion
'現在の集計を削除
rngデータ範囲.RemoveSubtotal
int列数 = rngデータ範囲.Columns.Count '列数取得
int集計レベル = int列数 - 1 '集計レベル指定用
int基準列 = Application.InputBox _
("集計の基準となる列を数値で指定", _
Default:=1, Type:=1)
int集計列 = Application.InputBox _
("集計の対象となる列を数値で指定", _
Default:=int列数, Type:=1)
'集計の設定
rngデータ範囲.Subtotal GroupBy:=int基準列, Function:=xlSum, _
TotalList:=int集計列, Replace:=True, _
PageBreaks:=False, SummaryBelowData:=True
'対象シートのactivesheet.outlineをオブジェクト(Outline)型変数に格納
'集計レベルを最大レベルに指定
ActiveSheet.Outline.ShowLevels int集計レベル
'対象シートのあるウィンドウのアウトラインを非表示
ActiveWindow.DisplayOutline = False
'対象セル領域の拡張
Set rngデータ範囲 = rngデータ範囲.CurrentRegion
End With
End Sub
'=============================
Private Sub CmdChangeLevel_Click()
'現在の集計レベルが最大になっている場合にはカウンタを戻す
If int集計レベル >= (int列数 - 1) Then
int集計レベル = 0
End If
int集計レベル = int集計レベル + 1
'集計レベルの変更
ActiveSheet.Outline.ShowLevels int集計レベル
End Sub
'=============================
Private Sub CmdCopyData_Click()
'新規ワークシートを追加して可視セルをコピー
Dim sht As Worksheet
Set sht = Worksheets.Add(after:=ActiveSheet)
rngデータ範囲.SpecialCells(xlCellTypeVisible).Copy _
Destination:=sht.Range("A1")
End Sub
|