Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


4431 / 76734 ←次へ | 前へ→

【77926】Re:VBAによるデータ抽出等について
発言  マナ  - 16/2/14(日) 0:27 -

引用なし
パスワード
   ▼株太郎 さん:
こんな風に考えてみました

1)データシートを新規ブックにコピー
2)高値が色付きセルなら、安値セルをクリアし、H列に行番号をセット
3)安値が色付きセルなら、高値セルをクリアし、H列に行番号をセット
4)H列が空白の行をオートフィルタで抽出し削除
5)H列の値から、セルの個数を計算(I列)
6)不要な列を削除

Sub test()
  Dim i As Long
  
  Sheets("Sheet1").Copy  '★データシート
  
  With ActiveSheet.Cells(1).CurrentRegion.Columns("A:H")
    For i = 2 To .Rows.Count
      If .Cells(i, "D").Interior.Color = vbBlue Then
        .Cells(i, "E").ClearContents
        .Cells(i, "H").Value = i
      ElseIf .Cells(i, "E").Interior.Color = vbRed Then
        .Cells(i, "D").ClearContents
        .Cells(i, "H").Value = i
      End If
    Next

    .AutoFilter
    .AutoFilter Field:=8, Criteria1:="="
    .Offset(1).EntireRow.Delete
    .AutoFilter
    .Interior.Color = xlNone

    If .Rows.Count > 1 Then
      With .Columns("I").Resize(.Rows.Count - 1).Offset(1)
        .FormulaR1C1 = "=IF(R[-1]C[-1]="""","""",RC[-1]-R[-1]C[-1])"
        .Value = .Value
      End With
    End If
    .Cells(1, "I").Value = "セルの個数"
    .Columns("F:H").Delete
    .Columns("B:C").Delete
    .Cells(1).Select
  End With
      
End Sub

5 hits

【77924】VBAによるデータ抽出等について 株太郎 16/2/13(土) 17:15 質問[未読]
【77925】Re:VBAによるデータ抽出等について β 16/2/13(土) 19:42 発言[未読]
【77926】Re:VBAによるデータ抽出等について マナ 16/2/14(日) 0:27 発言[未読]
【77927】Re:VBAによるデータ抽出等について β 16/2/14(日) 9:26 発言[未読]
【77929】Re:VBAによるデータ抽出等について マナ 16/2/14(日) 12:56 発言[未読]
【77931】Re:VBAによるデータ抽出等について 株太郎 16/2/14(日) 13:25 回答[未読]
【77935】Re:VBAによるデータ抽出等について マナ 16/2/14(日) 15:36 発言[未読]
【77936】Re:VBAによるデータ抽出等について 株太郎 16/2/14(日) 16:33 お礼[未読]
【77928】Re:VBAによるデータ抽出等について β 16/2/14(日) 9:36 発言[未読]
【77930】Re:VBAによるデータ抽出等について 株太郎 16/2/14(日) 13:07 回答[未読]
【77932】Re:VBAによるデータ抽出等について β 16/2/14(日) 14:07 発言[未読]
【77934】Re:VBAによるデータ抽出等について 株太郎 16/2/14(日) 15:30 お礼[未読]
【77933】Re:VBAによるデータ抽出等について β 16/2/14(日) 14:09 発言[未読]

4431 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free