エクセルで最大値最小値を残して間引きをしたい

質問

エクセル2000を使用しています。
電圧と温度の数値データが100列×20万行のCSVで保存してあります。
このデータを解析の為エクセルで読み込みたいのですが、
データの行数が多い為読み込めません。
そこでデータを間引いて取り込みたいのですが、過去ログやWEBには
「数行毎に削除して取り込み」しか見つけられませんでした。
これではピーク値を削除してしまう可能性があるので、
10行毎に最大値と最小値を残して削除をしたいです。
例
1 7
2 8
3 9
4 10
5 11
6 12
これを3行ごとに間引き
1 7 （1~3行の最小値）
3 9　(1~3行の最大値)
4 10 (4~6行の最小値)
6 12 (4~6行の最大値)
のように間引きをしたいです。

大きなCSVを複数のシートに分割して読み込むマクロは組めたので、
CSV読み込みからでは無く、エクセル上で上記のように間引きが
行えるだけでも大変助かります。
よろしくお願いします。

回答No.4

mt2008 · ベストアンサー

100×20万なんて巨大なCSVファイルでは確認していませんが、私ならこんな感じでやるかなぁ。

Sheet1をワーク用のシートとして使用し、Sheet2に間引きしたデータを貼り付けるとします。
Sheet2は空にしておきます。
Sheet1の1～10行までが、CSVの値を貼り付ける仮のエリアとします。
今回のやり方でCSVからそのまま貼り付けると文字列になるので、
A11に　=IF(A1="","",VALUE(A1)) と入れてCV20(100列目）までコピーします。
これでA11:CV20 には数値が入ります。ここから最大値・最小値をセル演算で出します。
A21に　=MAX(A11:A20)
A22に　=MIN(A11:A20)　と、入れてCV列までコピー。この2行をマクロでSheet2に転記する事になります。
ここまでが下準備。
次に以下のマクロを動かします。マクロは、10行毎にSheet1の貼り付けエリアに貼り付けて、セル演算で計算された21・22行をSheet2にコピーしています。

Sub sample()
　Dim csvData
　Dim nCsvData() As Long
　Dim nFile As Integer
　Dim nRow, nCount As Long
　Dim sPath, sString As String

　Application.ScreenUpdating = False '画面の更新を停止して処理をスピードアップ

　'***** 開くCSVファイルをフルパスで
　sPath = "D:\data.csv"

　nFile = FreeFile　'空きファイル番号取得
　Open sPath For Input As #nFile 'CSVファイルオープン
　On Error GoTo ErrTrap '最低限のエラートラップ

　Sheets("Sheet1").Rows("1:10").ClearContents '仮貼り付けエリアの掃除
　nRow = 1　'10行毎の行数
　nCount = 1 '10行のセットが何個目

　Do While Not EOF(nFile) 'CSVの最後までループ

　　Line Input #nFile, sString '1行読み込み
　　csvData = Split(sString, ",") '「,」で別ける
　　'++++++++++ 仮貼り付けエリアのセルに代入
　　Sheets("Sheet1").Select
　　Range(Cells(nRow, 1), Cells(nRow, UBound(csvData) + 1)).Value = csvData

　　nRow = nRow + 1
　　'++++++++++ 10行毎の処理
　　If (nRow = 11) Then
　　　'ワーク用シートの最大値最小値を転記
　　　Worksheets("Sheet1").Rows("21:22").Select
　　　Selection.Copy
　　　Sheets("Sheet2").Select
　　　Range("A" & (nCount * 2 - 1)).Select
　　　Selection.PasteSpecial Paste:=xlPasteValues

　　　nRow = 1
　　　nCount = nCount + 1
　　　Sheets("Sheet1").Rows("1:10").ClearContents
　　End If

　Loop

　'***** 10行毎から余ったデータでも最大値・最小値を転記。
　If nRow > 1 Then
　　'ワーク用シートの最大値最小値を転記
　　Worksheets("Sheet1").Rows("21:22").Select
　　Selection.Copy
　　Sheets("Sheet2").Select
　　Range("A" & (nCount * 2 - 1)).Select
　　Selection.PasteSpecial Paste:=xlPasteValues
　End If

ErrTrap:
　Close #nFile
　Application.ScreenUpdating = True '画面の更新を再開

End Sub

お礼

回答ありがとうございました。
この方法のおかげでCSVを複数のシートに分割しないでも
処理する事が出来るようになりました。

回答No.3

noname#204879

A　 B　C
1　　7　　　7
2　　8　　　9
3　　9　　 10
4　 10　　 12
5　 11　　 15
6　 12　　 99
7　 35　　 82
8　 15　　 94
9　 99
10　94
11　88
12　82

C1: =MIN(OFFSET(A$1,ROUNDUP((ROW(A1)-1)/2,0)*3,,3,))
C2: =MAX(OFFSET(A$1,ROUNDUP((ROW(A1)-1)/2,0)*3,,3,))
範囲 C1:C2 を選択して、此れを下方にズズーッとドラッグ＆ペースト

お礼

回答ありがとうございます。
参考にさせて頂きます。

回答No.2

imogasi

質問者はマクロを組めた例があるようなので、ｃｓｖ作成時に間引きことを考えるべきだ。何でもエクセルというのは進歩が無い。
そのロジックを考えると、
１項目のデータだとレコードの内容の溜め込みをしなくて済むと思うが、考えてみると、２項目でも（全レコードは）溜め込みをしなくて済むように思う。４レコード分は必要と思うが
２０レコード（なぜ２０か、理由は下記でわかる）を１単位（塊）に考えて
まず全レコードで最小値以下（ありえなさそうな値）を初期値で見積もる。項目１＝Ｘ１、項目２＝Ｘ２の２つ必要。
また全レコードで最大値以上（ありえなさそうな値）を初期値で見積もる。項目１＝Ｙ１、項目２＝Ｙ２の２つ必要
以上は初期値設定。
ーー
今読んだレコードで、項目１、項目２について最小値より少なければ
最小値を置き換える。そのとき項目１と項目２はどちらでも、（最多２０レコードのうちの）、途中の今までの一方の項目でも最小なら、項目１と項目２のペアで記録する。
最大値も同じ。
今読んだレコードで、項目１、項目２それぞれについて今までの最大値より大であれば、最大値を置き換える。そのとき項目１と項目２はどちらでも、２０レコードのうちの、どちらかの項目で今までの最大なら２項目ペアで記録する。
２０レコードを処理して後、最小値のレコード２つ（それぞれ項目１と項目2）と、最大値を示した２つ（それぞれ項目１と項目2）の４つを書き出す。
これで４/２０の５分の１に減るはず。
基本的にはプログラム学習の最初に学ぶ、最大値、最小値を求めると同じで、それを２０レコードごとに区切って続けて行うということ。
参考
イメージ的には、２０レコードの点をプロットしたとして、もっとも広い４辺の４角形の４辺に落ちた点を書き出すことになるのかな（下記の■）。
－ー■ーーーー　項目２
｜　　 　　　｜　｜
■　　　 　　｜　Ｖ
｜　　　 　　■
｜　　　 　　｜
｜-－－■ーー
項目１－－＞

お礼

回答ありがとうございます。
データロガーから随時パソコンにデータを転送できる構成
だったらロギングしながら欲しいデータだけを保存するのですが、
今回のデータロガーはメモリー保存しか出来ない為、
メモリーに保存したデータを少しでも軽くする為に今回の
質問をさせて頂きました。

回答No.1

maron--5

＿＿＿Ａ＿＿＿＿Ｂ
1＿＿データ＿＿抽出
2＿＿＿7＿＿＿＿1
3＿＿＿8＿＿＿＿0
4＿＿＿9＿＿＿＿1
5＿＿＿10＿＿＿＿1
6＿＿＿11＿＿＿＿0
7＿＿＿12＿＿＿＿1

B2=IF(OR(A2=MIN(OFFSET($A$2:$A$4,INT((ROW(A1)-1)/3)*3,)),A2=MAX(OFFSET($A$2:$A$4,INT((ROW(A1)-1)/3)*3,))),1,0)
★下にコピー

◆「抽出」の「1」をフィルタで抽出

お礼

回答ありがとうございました。参考にさせて頂きます。
オフセット関数を使う方法は試したのですが、
如何せんデータの量が大量なので、手動だと時間が掛かりすぎて
しまう為バックグラウンドで処理できるような方法を探していました。