データ抜き出しマクロの改良

質問

以下のプログラムは10行ごとにデータを抜き出すプログラムです。
これに追加して例えば5結果の変動があったとき、10%結果の変動が
あった時にデータを抜き出すようにするにはどうすればいいですか？
普段は10行に一個データを抜き出すんですが、それに追加して前回の値より5多くなった点もプロットするとか、10%増減したらプロットするとかにしたいです。

Sub nukitori()

Dim X As Worksheet
Dim i As Long
Dim ii As Long
Dim col As Integer
Dim Nukitori_Step As Long

Nukitori_Step = 10

i = 2
ii = 2 '●●●見出し行が１行目なので２で始める

Set X = ActiveSheet

'●シートShordataがあったら削除
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("shortdata").Delete
Application.DisplayAlerts = True
On Error GoTo 0

Worksheets.Add.Name = "shortdata"

'●先ず、見出しをコピー
Worksheets("shortdata").Rows(1).Value = X.Rows(1).Value

While X.Cells(i, 1) <> "" And i < 65535
For col = 1 To 255
Worksheets("shortdata").Cells(ii, col).Value = X.Cells(i, col).Value
Next
If i = 2 Then i = 1
i = i + Nukitori_Step
ii = ii + 1
Wend

End Sub

回答No.1

n-jun · ベストアンサー

＞前回の値より5多くなった点もプロットするとか

＞For col = 1 To 255
＞Worksheets("shortdata").Cells(ii, col).Value = X.Cells(i, col).Value
＞Next
を
For col = 1 To 255
With Worksheets("shortdata").Cells(ii, col)
.Value = X.Cells(i, col).Value

'１行上の値より５以上大きければセルを黄色で塗りつぶす
If ii > 2 And .Value >= .Offset(-1).Value + 5 Then
.Interior.ColorIndex = 6
End If
End With
Next

動作チェックなしですし、勘違いならごめんなさい。

お礼

ありがとうございます。
やってみます。
5大きくなったらというよりも、ある一定の値(例えば5)前回の値より増減
すればプロットするようにしたいです。

回答No.3

n-jun

＃２です。

＞エラーが出ます。
＞動作チェックして全てのプログラムを書いてもらうと大変ありがたいです。
＞もう一度チェックしますと、普段は10行に1個データをぬきとっていて、前回の値よりも10増減した点もプロットする、
＞前回の値よりも20%値が変化したらデータをプロットするプログラムを作ってほしいです。
どのようなデータからどのような処理を行なって、どのような結果を出したいのか
それらが不明なので完全なコードは私には無理です。

５増減とか１０増減とか、１０％とか２０％とか条件が度々変るのも問題かも。
結局１０行毎ではなく１行毎にデータを比較していかないと希望の変化点は見つけられないと想うんですが、
詳細が不明なので勘違いかもしれません。

お礼

ありがとうございます。

毎行ごとにデータを調べてたらとても大変なので、(30分の実験で1800点ある)自動でできるプログラムがあればと思いまして。
なんとかならないでしょうかね？
例えば以下のようにしたいです。

time result
1　　　1
2　　　1
3　　　1
4　　　1
5　　　1
6　　　1
7　　　1
8　　　1
9　　　1
10　　 1
11　　100
12　　500
13　　1000
14　　1000
15　　1000
16　　1000
17　　1000
18　　1000
19　　1000
20　　1000
　↓
time result
1　　　1
10　　1
11　　100
12　　500
13　　1000
20　　1000

回答No.2

n-jun

＃１です。

＞If ii > 2 And .Value >= .Offset(-1).Value + 5 Then
＞.Interior.ColorIndex = 6
＞End If
を
If ii > 2 Then
If .Value >= .Offset(-1).Value + 5 Or .Value <= .Offset(-1).Value - 5 Then
.Interior.ColorIndex = 6
End If
End If

とかかな。

お礼

すいません。
エラーが出ます。
動作チェックして全てのプログラムを書いてもらうと大変ありがたいです。
コピペして使うので。

もう一度チェックしますと、普段は10行に1個データをぬきとっていて、前回の値よりも10増減した点もプロットする、前回の値よりも20%値が変化したらデータをプロットするプログラムを作ってほしいです。