データの平均を1分値にまとめる方法・マクロ

質問

Windows7　Excel2007を使用しています。

ほぼ 1秒毎のデータの平均を１分値にしてまとめたいです。
しかし量が膨大すぎて、よいやり方をご存知であれば、教えて下さい。

データ形式は下記のようになっています。（列はIVまでありますので、端折ってます。）
（時間　2011/9/2 9:19　は一つのセルです。）

[LOGGING]　　　　　1 2 3 4 5 6 7 8 0
DATETIME　　　　　No　ア イ ウ エ オ カ キ ク
TIME 　No ア イ ウ エ オ カ キ ク
2011/9/2 9:19 1 0 1 0 0 0 0 0 0
2011/9/2 9:19 2 0 1 0 0 0 0 0 0
2011/9/2 9:19 3 0 1 0 0 0 0 0 0
2011/9/2 9:19 4 0 1 0 0 0 0 0 0
2011/9/2 9:19 5 0 1 0 0 0 0 0 0
2011/9/2 9:19 6 0 1 0 0 0 0 0 0
2011/9/2 9:19 7 0 1 0 0 0 0 0 0
2011/9/2 9:19 8 0 1 0 0 0 0 0 0
2011/9/2 9:19 9 0 1 0 0 0 0 0 0
2011/9/2 9:19 10 0 1 0 0 0 0 0 0
2011/9/2 9:19 11 0 1 0 0 0 0 0 0
2011/9/2 9:19 12 0 1 0 0 0 0 0 0
2011/9/2 9:19 13 0 1 0 0 0 0 0 0
2011/9/2 9:19 14 0 1 0 0 0 0 0 0
2011/9/2 9:19 15 0 1 0 0 0 0 0 0

上の３行は無視します。
列EXの値に1/10を掛けて、それを1分毎に平均化したいです。
列FBの値に1/1000を掛けて、それを1分毎に平均化したいです。

WorkSheet1 にデータがあった場合、WorkSheet2に上記の平均化した値を表示したいです。

ネットを検索していると、下記に似たような質問と回答のサンプルコードがありました。
これを改良して作ることはできないでしょうか？
データが膨大なので、是非マクロを使ってやってみたいと思っています。

www.excel.studio-kazu.jp/kw/20090528191508.html

Sub SetAverage()
Dim ws1 As Worksheet
Set ws1 = Worksheets(1)

Dim ws2 As Worksheet
Set ws2 = Worksheets(2)

Dim averageFormulaC As String
Dim averageFormulaD As String
averageFormulaC = "=AVERAGE(" & ws1.Name & "!C@S@:C@E@)"
averageFormulaD = "=AVERAGE(" & ws1.Name & "!D@S@:D@E@)"

Dim i As Long
Dim lastRow As Long
lastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row

ws2.Columns("A:D").Clear
ws2.Range("B1").Resize(lastRow, 1).NumberFormatLocal = "hh:mm;@"

Dim startRow As Long
startRow = 1
Dim currentMin As Long
currentMin = Int(ws1.Range("B1").Value * 1440.001)
Dim r As Long
r = 1
For i = 1 To lastRow
If currentMin <> Int(ws1.Cells(i + 1, "B").Value * 1440.001) Then
ws2.Range("A" & r).Value = ws1.Cells(i, "A").Value
ws2.Range("B" & r).Value = CDbl(currentMin) / 1440#
ws2.Range("C" & r).Formula = Replace(Replace(averageFormulaC, "@S@", startRow), "@E@", i)
ws2.Range("D" & r).Formula = Replace(Replace(averageFormulaD, "@S@", startRow), "@E@", i)
r = r + 1

currentMin = CLng(ws1.Cells(i, "B").Value * 1440.001)
startRow = i + 1
End If
Next
End Sub

回答No.1

keithin · ベストアンサー

先に一般によく引っかかる説明不足点として，幾つか指摘しておきます。

不明点のその１：
＞ほぼ 1秒毎のデータ
＞時間　2011/9/2 9:19　は一つのセルです

時刻列がどこなのか不明ですがまぁそれはたいしたことじゃなくて，「2011/9/2 9:19」は正確な内容は？
「2011/9/2 9:19:00」が並んでいるのか，実は「2011/9/2 9:19:01」「2011/9/2 9:19:02」…と実時刻が記録されているのを，単に表示でそう見えているだけなのか，という事です。
→後者を仮定します

不明点のその２：
まぁアタリマエの事ですが，１分間に必ず６０点のデータが記録されている「保証はない」（イチイチ毎分のデータ数を数える必要がある）という前提が必要か。
→必ずしも６０点とは限らないを仮定します

不明点のその３：
１分値の開始と終了は「9:19:00以上から9:20:00未満まで」を9:19とするのか，「9:19:01から9:20:00」を9:20の値とするのか。
→実は後者を使う場合も多いのですが，今回は前者を仮定します

＃日付時刻がＡ列と仮定して

sub macro1()
　dim ws1 as worksheet, ws2 as worksheet
　dim lastrow as long
　set ws1 = worksheets("Sheet1")
　set ws2 = worksheets("Sheet2")
　lastrow = ws1.cells(cells.rows.count ,"A").end(xlup).row
　ws2.range("A:F").clearcontents
　ws2.range("A3:F3") = array("datetime", "data count", "sum(EX)","sum(FB)","avr(EX)","avr(FB)")

’時刻が丸め済みなら下記の計算は不要，転記するだけで十分。
　with ws2.range("A4:A" & lastrow)
　　.formula = "=TEXT(Sheet1!A4,""yyyy/mm/dd hh:mm"")*1"
　　.value = .value
　　.numberformatlocal = "hhhh/mm/dd hh:mm"
　end with

’抽出
　ws2.range("A3:A" & lastrow).removeduplicates columns:=1, header:=xlyes
　lastrow = ws2.cells(cells.rows.count, "A").end(xlup).row

’計算
　ws2.range("B4:B" & lastrow).formula = "=COUNTIFS(Sheet1!A:A,"">=""&A4,Sheet1!A:A,""<""&(A4+TIME(0,1,0)))"
　ws2.range("C4:C" & lastrow).formula = "=SUMIFS(Sheet1!EX:EX,Sheet1!A:A,"">=""&A4,Sheet1!A:A,""<""&(A4+TIME(0,1,0)))/10"
　ws2.range("D4:D" & lastrow).formula = "=SUMIFS(Sheet1!FB:FB,Sheet1!A:A,"">=""&A4,Sheet1!A:A,""<""&(A4+TIME(0,1,0)))/1000"
　ws2.range("E4:E" & lastrow).formula = "=C4/B4"
　ws2.range("F4:F" & lastrow).formula = "=D4/B4"
end sub

お礼

ありがとうございました！

１００％解決できました。

マクロの凄さを体感しております。
教えて頂いてマクロを少し改造しながら使ってみています。
今　１０秒平均に挑戦中です。