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

Question

エクセル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読み込みからでは無く、エクセル上で上記のように間引きが
行えるだけでも大変助かります。
よろしくお願いします。

mt2008 · Accepted Answer

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

mike_g · Answer

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 を選択して、此れを下方にズズーッとドラッグ＆ペースト

imogasi · Answer

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

maron--5 · Answer

＿＿＿Ａ＿＿＿＿Ｂ
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」をフィルタで抽出

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

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

A B C

質問者はマクロを組めた例があるようなので、ｃｓｖ作成時に間引きことを考えるべきだ。

＿＿＿Ａ＿＿＿＿Ｂ

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

　　A　 B　C