|
▼本山中 さん:
ということは番号はA列ではなく、B列ということだったんですね。
コード案です。まだ、レイアウトに誤解があるかもしれません。
誤解していたら指摘願います。
Sub Sample()
Dim f As Long, t As Long
Dim c As Range
Dim delRows As Range
Cells.Font.ColorIndex = xlAutomatic '昨日の色塗りをいったん解除
f = 2 '同じ番号の行の最初の行番号
'B2からB列データ最終行までのセルを抽出
For Each c In Range("B2", Range("B" & Rows.Count).End(xlUp))
t = c.Row '同じ番号の行の最後の行番号
If c.Value <> c.Offset(1).Value Then 'これが同じ番号の最後なら
If t > f Then '同じ番号が2行以上あれば処理
If Cells(t, "H").Value > Cells(t - 1, "H").Value Then
Rows(t).Font.Color = vbRed '直近より最新の利益が大きければ最新の行の文字色を赤に
ElseIf Cells(t, "H").Value < Cells(t - 1, "H").Value Then
'直近より最新の利益が小さければ最新の行のみを残しあとは削除
If delRows Is Nothing Then
Set delRows = Rows(f & ":" & t - 1)
Else
Set delRows = Union(delRows, Rows(f & ":" & t - 1))
End If
End If
End If
f = t + 1
End If
Next
'削除すべき行があった場合はそれを一括削除
If Not delRows Is Nothing Then delRows.Delete
End Sub
|
|