|
▼株太郎 さん:
こんな風に考えてみました
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
|
|