VBAのデータ抽出(間引き)について

質問

VBAのデータ抽出(間引き)について

当方VBA初心者なのですが、
VBA(EXCEL2007)を使用してグラフ作成をしようと思っています。

元データの書式は以下の通りでデータ行は30秒間隔で
一カ月分(8万行)あります。

2010/08/01 01:00:34　　　　　1112.83
2010/08/01 01:01:04　　　　　1110.43
2010/08/01 01:01:34　　　　　1111.87
2010/08/01 01:02:04　　　　　1112.23
2010/08/01 01:02:34　　　　　1112.43
2010/08/01 01:03:04　　　　　1112.03
2010/08/01 01:03:34　　　　　1110.83
2010/08/01 01:04:04　　　　　1112.43
2010/08/01 01:04:34　　　　　1110.63
・・・

データ量が多すぎるので間引きしようと思っています。
間引き(抽出)条件は以下の様に考えています。

10行毎(5分毎)に値の最大値の行を抽出して別シートへコピー。

VBAマクロで処理するにはどの様な
コードで実現可能でしょうか？

教えて頂きたく。よろしくお願いします。

回答No.1

merlionXX · ベストアンサー

一例です。
日付時間データがA列、数値データがB列にあり、途中に空白行はないものとします。
データがあるのがSheet1でSheet2に転記します。
データはA1セルから始まっているものとしましたが、もしA2なら
Set myC = .Range("A1") 'データ開始位置
の部分を変えてください。

Sub test01()
　　Dim myC As Range, tg As Range '変数宣言
　　Dim x As Double
　　Dim i As Long
　　With Sheets("Sheet1") 'Sheet1で
　　　　Set myC = .Range("A1") 'データ開始位置
　　　　Do While myC <> "" 'データがある限り
　　　　　　x = Application.Max(myC.Offset(, 1).Resize(10)) '対象10セルの最大値取得
　　　　　　Set tg = myC.Offset(, 1).Resize(10).Find(What:=x, LookAt:=xlWhole) '最大値セル位置取得
　　　　　　i = i + 1 'カウント
　　　　　　tg.Offset(, -1).Resize(, 2).Copy Sheets("Sheet2").Cells(i, "A").Resize(, 2) '対象行コピペ
　　　　　　Set myC = myC.Offset(10) '10行下に移動
　　　　Loop '繰り返す
　　End With
　　Set myC = Nothing '後処理
　　Set tg = Nothing
End Sub

お礼

本当にありがとうございました。

お陰様で解決いたしました。