• 締切済み

抜き出しマクロ(3)

以下のプログラムは10行ごとにデータを抜き出すプログラムです。 これに追加して、普段は10行に1個データを抜き出し、前回の結果より絶対値が10増減があったとき、 相対値が10%の増減があった時にもデータを抜き出すようにするにはどうすればいいですか? 例えば以下の通り 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 21  1000 ・  ・ ・  ・ ・  ・  ↓ time result 1   1 10  1 11  100 12  500 13  1000 20  1000 ・  ・ ・  ・ ・  ・ ここからプログラム(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 '●●●見出し行が1行目なので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 ここからプログラム(10行ごとに抜き出す+増減があった場合も抜き出す) ただし以下の箇所でエラーが起こる If i > 3 And Abs(Cells(i, 1) - Cells(i - 1)) >= 10 Then 中断モードでコードを実行することができませんと。 ↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ Sub 抽出() Dim i As Long Dim j As Long Dim ws1 As Worksheet Dim ws2 As Worksheet Dim Lastline As Long Dim SelFlg As Boolean '抽出データかどうかの Set ws1 = Worksheets("OriginDT") '元データ Set ws2 = Worksheets("SelectDT") '抽出データ Lastline = ws1.Cells(Rows.Count, 1).End(xlUp).Row '最終行番号を取得 ws2.Cells(1, 1) = ws1.Cells(1, 1) '見出し部分のコピー ws2.Cells(1, 2) = ws1.Cells(1, 2) j = 1 For i = 2 To Lastline SelFlg = False '10で割ったあまりが1(つまり10行おき)または最初のデータのとき If i Mod 10 = 1 Or i = 2 Then ' SelFlg = True '抽出対象にする End If '2行目以降で一つ上の行との差が10以上のとき If i > 3 And Abs(Cells(i, 1) - Cells(i - 1)) >= 10 Then SelFlg = True '抽出対象にする End If If SelFlg = True Then '抽出対象だったらコピー j = j + 1 ws2.Cells(j, 1) = ws1.Cells(i, 1) ws2.Cells(j, 2) = ws1.Cells(i, 2) End If Next End Sub

みんなの回答

  • imogasi
  • ベストアンサー率27% (4737/17069)
回答No.1

質問の意味がわかりにくい 例えば (1)基本は10行ごとに抜き出す (2)ただし、直前に抜き出した数より   A.絶対値(引き算して)10%増減があれば抜き出す   OR   B.相対値(割り算をして)が10%の増減があったときも抜き出す とでも書けば判りやすい。 === ロジックをフローチャート的に書いて、じっくり考えたのか? ロジック以外は質問するほど難しいことは何も無いのでは。 IF分で場合分け  引き算  割り算 の単純な計算でしかない(全て絶対値で考えるのか)    ========- ここはエラーの添削コーナーではない。長々と質問文を書いて、読者の時間を取らさないこと。もっと質問文は短くなるはず。 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 質問に載せるのはこの辺りだけで良いのでは。 ーー データ列には途中空白セルがあるのか? 負のデータがあるのか ーーー 処理ロジック 基本は、上記(2)の条件があるので、全行を処理対象にせざるを得ない。 また直前の抜き出し行を変数に保持 上記(2)の条件を判定   該当すれば抜き出し    かつ直前の抜き出し行の変数にその行をセット   該当該当し無い場合は、直前の抜き出し行と比べ10行以上なら   書き出し。    かつ直前の抜き出し行の変数にその行をセット この全行あて繰り返しだろう。 何処が難しい? 判定計算の算式部分で判らないのなら、その旨明記して、質問すべきだ。

ohayogurt
質問者

お礼

なにキレてるんですか? 長いなら見なければいいでしょう? 僕はマクロ初心者なので。

関連するQ&A