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

質問

以下のプログラムを
（１）基本は１０行ごとに抜き出す
（２）ただし、直前に抜き出した数より
　　A.絶対値（引き算して）１０％増減があれば抜き出す
　　OR
　　B.相対値（割り算をして）が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.5

n-jun · ベストアンサー

Sub nukitori_2()

Dim X As Worksheet
Dim i As Long
Dim ii As Long
Dim col As Integer
Dim Nukitori_Step As Long
Dim a, b, ch As Boolean

Nukitori_Step = 10

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

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

If i = 2 Or i Mod 10 = 1 Then
ch = True
Else
For col = 2 To 2 '1～255？
a = Worksheets("shortdata").Cells(ii - 1, col).Value
b = X.Cells(i, col).Value
If Abs(a - b) >= 10 Or Abs(1 - a / b) >= 0.1 Then ch = True: Exit For
Next
End If

If ch = True Then
Worksheets("shortdata").Cells(ii, 1).Resize(, 255).Value = X.Cells(i, 1).Resize(, 255).Value
ii = ii + 1: ch = False
End If

i = i + 1
Wend

End Sub

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
＞For col = 2 To 2 '1～255？
ここについては実際に【比較の必要のある】データ列範囲を入れて下さい。

お礼

以下でエラーが起こりました。
If Abs(a - b) >= 10 Or Abs(1 - a / b) >= 0.1 Then
ゼロで除算したとでました。

データにはマイナスも含まれています。

回答No.4

30246kiku

疑似環境、疑似データで作成しても
http://oshiete1.goo.ne.jp/qa5412274.html
の様に

> エラーは、
> Set ws1 = Worksheets("OriginDT") '元データ
> の箇所で起こります。

となるのではありませんか。

正式な環境、データでの動作確認は、質問者にしかできません。

回答No.2

30246kiku

＃１です

> ws2.Cells(1, 1) = ws1.Cells(2, 1)
> ws2.Cells(1, 2) = ws1.Cells(2, 2)
> j = 2
> For i = 3 To Lastline

ごめんなさい。

ws2.Cells(2, 1) = ws1.Cells(2, 1)
ws2.Cells(2, 2) = ws1.Cells(2, 2)
j = 3
For i = 3 To Lastline

でしたね

回答No.1

30246kiku

前回のもの
http://oshiete1.goo.ne.jp/qa5413532.html
に回答しようとしたら、ついさっきしめられたので、その内容で回答します。

----------------------------------------------------------------------
エクセルは詳しくないのですが、見た目で・・・

> If i > 3 And Abs(Cells(i, 1) - Cells(i - 1)) >= 10 Then
↓
If i >= 3 And Abs(Cells(i, 1) - Cells(i - 1, 1)) >= 10 Then

こんな単純なものではないですよね。
（ ws1. とかの修飾も必要な気もしますが）

他の方が書いたものでも自分のものとして質問されるのなら
最低限、処理内容、記述内容は確認すると思います。

以下私の考える検討箇所）

※ ABS の対象は A列でいいの？B列なら Cells(i,2) のようになるのでしょうか？

※
If i >= 3 And Abs(・・・) >= 10 Then

がいいのか

If i >= 3 Then
　　If Abs(・・・) >= 10 Then

がいいのか

※
i Mod 10 = 1 でいいのか、i Mod 10 = 2 なのか

※
ws2.Cells(1, 1) = ws1.Cells(2, 1)
ws2.Cells(1, 2) = ws1.Cells(2, 2)
j = 2
For i = 3 To Lastline

にすれば、For 内の判別が楽になるんじゃ？
（i = 2 や　i >=3 は不要に）

※
> 相対値が10%の増減があった時 の処理は、
同じ個所で式を作って判別させればよいと思います。

お礼

ありがとうございます。

それで全てのコードを書いて直して、動作チェックしてから回答してもらうとありがたいです。
修論に載せるデータ整理のためです。
僕はマクロ詳しくないので、皆さんの回答お待ちしております。