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

0 hits

▼

【9820】こんな合計の出し方って・・・ 翡翠 03/12/17(水) 17:48