Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

5435 / 76732

←次へ　｜　前へ→


	【76910】Re:日時の集計

β - 15/4/10(金) 13:37 -


	引用なし

	パスワード

▼chou さん：

↑　と、大見得をきりましたが、実際にどれぐらいかかるか？
以下でお試しください。
H列に所要時間を記載、データ最終行の下のH列に合計と平均を記載します。

Sub Test()
　　Dim w As Variant
　　Dim c As Range
　　Dim st As Double
　　Dim ed As Double
　　Dim tot As Double
　　Dim cnt As Long
　　
　　With Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 7)
　　　　ReDim w(1 To .Rows.Count, 1 To 1)
　　　　w(1, 1) = "所要時間"
　　　　For Each c In .Columns(1).Offset(1).Resize(.Rows.Count + 1).Cells
　　　　　　If c.Row > 2 Then
　　　　　　　　If c.Value <> c.Offset(-1).Value Then
　　　　　　　　　　w(c.Row - 1, 1) = ed - st
　　　　　　　　　　tot = tot + ed - st
　　　　　　　　　　cnt = cnt + 1
　　　　　　　　End If
　　　　　　End If
　　　　　　If c.Row > .Rows.Count Then Exit For
　　　　　　st = c.Offset(, 4).Value2
　　　　　　ed = c.Offset(, 4).Value2
　　　　　　If Not IsEmpty(c.Offset(, 6)) Then ed = c.Offset(, 6).Value2
　　　　Next
　　　　.Columns(8).Value = w
　　　　.Range("G" & .Rows.Count).Offset(1).Value = "合計"
　　　　.Range("H" & .Rows.Count).Offset(1).Value = tot
　　　　.Range("G" & .Rows.Count).Offset(2).Value = "平均"
　　　　.Range("H" & .Rows.Count).Offset(2).Value = tot / cnt
　　End With
End Sub

199 hits

▼

【76904】日時の集計 chou 15/4/9(木) 16:27