Excel VBA質問箱 IV

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

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


71389 / 76738 ←次へ | 前へ→

【9844】Re:こんな合計の出し方って・・・
回答  Kein  - 03/12/18(木) 14:24 -

引用なし
パスワード
   必ずしもご希望どうりというわけではないですが・・

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 "東北*" を修正して下さい。
あと、見やすいようにアウトラインはクリアしてありますが、集計の処理が
されていることには変わりがないので、データ全体を消すときは、まず
シート全体のセルを選択し、必ず「データ」「集計」で「すべて削除」のボタン
を押してからクリアして下さい。
0 hits

【9820】こんな合計の出し方って・・・ 翡翠 03/12/17(水) 17:48 質問
【9842】Re:こんな合計の出し方って・・・ Jaka 03/12/18(木) 13:59 発言
【9844】Re:こんな合計の出し方って・・・ Kein 03/12/18(木) 14:24 回答
【9847】Re:こんな合計の出し方って・・・ 翡翠 03/12/18(木) 17:05 お礼

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