エラー処理 ＶＢＡ その２

下記のコードは某氏から頂戴致しました。
さらにもう一つ追加でやりたいことが
ございません。
おしえてくれませんでしょうか
画像添付のように
したいのですが。
おしえてくれませんでしょうか

Sub ?W?v()
Dim i As Long
Range("b3").CurrentRegion.Sort key1:=Range("c3"), _
order1:=xlAscending, Header:=xlYes

For i = Cells(Rows.Count, 3).End(xlUp).Row To 5 Step -1
If Month(Cells(i, 3)) <> Month(Cells(i - 1, 3)) Then
Rows(i & ":" & i + 1).Insert
End If
Next

End Sub

質問者からの補足コメント

• 

  エラー処理ではないのですが、
  合計と合計値をやりたいのです。

    補足日時：2019/06/25 21:45

• 

  subtotalではやりたくないのです
  アウトラインがあまり好きではないからです
  なにをどうすればいいのかわからないのが
  正直なところです。

    補足日時：2019/06/25 22:13

No.1 ベストアンサー 回答者： めぐみん_ 回答日時： 2019/06/26 08:39

空白行を追加しつつUNIONメソッドを使ってしまえば、１度のループ処理でも可能でしょうけどね。

敢えて既出の回答には触れず、その後ろにもう１回分のループを付け足しました。
空白セルを無視しデータ（数値である事）のあるセルを集団（.Areas）として捉えＳＵＭ関数で計算させてます。

Dim r As Range ' 最初で宣言

'---以下を空白行追加ループが終了した後ろに追加して下さい---

For Each r In Range("L4", Cells(Rows.Count, "L").End(xlUp)).SpecialCells(xlCellTypeConstants, xlNumbers).Areas
With r.Resize(1).Offset(r.Rows.Count)
.Offset(, -1).Value = "合計"
.Value = WorksheetFunction.Sum(r)
End With
Next

この回答へのお礼

いつも大変お世話になっております。

このコード貼り付けたところエラーが出て正直おかしいなと思いました。
SpecialCells(xlCellTypeConstants, xlNumbers)

xlNumbers　調べたところあっそうか　実をいうと金額のところに
式が入っていました。

これを値にして実行したところすばらい結果となりました。

なんて、凄いんだろうと思わずこのコード簡単に教えて
頂いたことに感謝しております。

有難うございます。

お礼日時：2019/06/26 09:40