|
必ずしもご希望どうりというわけではないですが・・
Sub TEST_集計()
Dim i As Long
Dim C As Range
Dim Ad As String
Application.ScreenUpdating = False
For i = Range("A65536").End(xlUp).Row To 2 Step -1
With Cells(i, 1)
Select Case True
Case .Value Like "*計*"
Rows(i).Delete xlShiftUp
Case .Value Like "*-*"
Rows(i).Delete xlShiftUp
Case .Value Like "*=*"
Rows(i).Delete xlShiftUp
End Select
End With
Next i
Range("A1").CurrentRegion.Subtotal 1, xlSum, Array(3, 4), True
For Each C In Columns(3).SpecialCells(3, 1)
Ad = Ad & C.Address(0, 0) & ","
If C.Offset(, -2).Value Like "東北*" Then
Ad = Left$(Ad, Len(Ad) - 1)
C.Offset(1).EntireRow.Insert xlShiftDown
C.Offset(1).Resize(, 2).Formula = "=SUM(" & Ad & ")"
C.Offset(1, -2).Value = "地区合計"
Ad = C.Offset(1).Address(0, 0) & ","
ElseIf C.Offset(, -2).Value = "総計" Then
Ad = Left$(Ad, InStrRev(Ad, ",", Len(Ad) - 1) - 1)
C.Resize(, 2).Formula = "=SUM(" & Ad & ")"
C.Offset(, -2).Value = "地区・デパート・コンビニ合計"
End If
Next
With Range("A1").CurrentRegion
.ClearOutline
.EntireColumn.AutoFit
End With
Application.ScreenUpdating = True
End Sub
地区の合計を出すところは、UPされている表のとおり"東北の1行下"という
条件にしています。他の地区名にするなら、Like "東北*" を修正して下さい。
あと、見やすいようにアウトラインはクリアしてありますが、集計の処理が
されていることには変わりがないので、データ全体を消すときは、まず
シート全体のセルを選択し、必ず「データ」「集計」で「すべて削除」のボタン
を押してからクリアして下さい。
|
|