即効テクニック |
サンプルではメニューの”データ” - ”集計”の機能を活用してレベルの切り替え、アウトライン記号の非表示、表示データのコピーなどを行います。 ※前提:シート上に集計可能なデータ コマンドボタン(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