|
最初の質問の表とデータのイメージが大幅の変更されている為
前のコードでは使い物に成りません
確認します
データの先頭(日付の始まる先頭行)は必ず7行目から始まるとします
一つの日付の終りは、2行の空の行が入るとします
F〜H列にデータが有る場合は、必ずB列に日付がはいるとします
この形でコードを作ると以下の様に成ります
Option Explicit
Public Sub AddUp2()
Dim i As Long
Dim j As Long
Dim lngListTop As Long
Dim lngListEnd As Long
Dim vntData As Variant
Dim vntSum(3) As Variant
Dim vntSubSum(3) As Variant
Dim blnCalc As Boolean
With ActiveSheet
'集計開始の先頭行を設定
lngListTop = 7
'最終行を取得
lngListEnd = .Cells(65536, "B").End(xlUp).Row + 1
'先頭行から最終行まで繰り返し
For i = lngListTop To lngListEnd
'現在行のB〜H列の値を取得
vntData = .Cells(i, "B").Resize(, 7).Value
'もし、B列が""なら(日付の終り)
If vntData(1, 1) = "" Then
If blnCalc Then
'小計を出力
.Cells(i, "E").Resize(, 4).Value = vntSubSum
'小計を計に加算、小計をクリア
For j = 0 To 3
vntSum(j) = vntSum(j) + vntSubSum(j)
vntSubSum(j) = 0
Next j
'集計終了
blnCalc = False
End If
Else
'もし、B列が""で無いなら(日付が有る場合)
If vntData(1, 1) <> "" Then
'集計開始
blnCalc = True
'小計にF〜H列値、及びカウントを加算
vntSubSum(0) = vntSubSum(0) + 1
For j = 1 To 3
vntSubSum(j) = vntSubSum(j) + vntData(1, 4 + j)
Next j
End If
End If
Next i
'計を出力
.Cells(i, "E").Resize(, 4).Value = vntSum
End With
Beep
MsgBox "処理完了"
End Sub
|
|