| 
    
     |  | F列が数値として認識出来ない場合は除外するコードを追加しました 
 Public Sub AddUp3()
 
 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列値、及びカウントを加算
 'もし、F列が数字なら小計に加算 ★修正
 If IsNumeric(Trim(vntData(1, 5))) Then
 vntSubSum(0) = vntSubSum(0) + 1
 For j = 1 To 3
 vntSubSum(j) = vntSubSum(j) _
 + Val(vntData(1, 4 + j))
 Next j
 End If
 End If
 End If
 Next i
 '計を出力
 .Cells(i, "E").Resize(, 4).Value = vntSum
 End With
 
 Beep
 MsgBox "処理完了"
 
 End Sub
 
 |  |