|
▼UO3 さん:
度々の回答をありがとうございます。
UO3 さんからのコードで、下記例を試してみました。
例(5月30日 3636 三菱総合研究所 20 を追加してみました)
5月14日 3635 コーエーテクモHLDG 10
5月15日 3635 コーエーテクモHLDG 11.55
5月16日 3635 コーエーテクモHLDG 12.07
5月16日 3636 三菱総合研究所 25.51
5月14日 3641 パピレス 12.08
5月15日 3641 パピレス 13.64
5月16日 3641 パピレス 15.65
5月14日 3644 1st HLDG 12.33
5月15日 3644 1st HLDG 11.89
5月16日 3644 1st HLDG 14.1
5月30日 3636 三菱総合研究所 20
結果
5月16日 3635 コーエーテクモHLDG 12.07
5月16日 3641 パピレス 15.65
5月16日 3644 1st HLDG 14.1
だけが赤くなりました。
希望するのは
1.5月30日 3636 三菱総合研究所 20 が
5月14日 3635 コーエーテクモHLDG 10
5月15日 3635 コーエーテクモHLDG 11.55
5月16日 3635 コーエーテクモHLDG 12.07
5月16日 3636 三菱総合研究所 25.51
5月30日 3636 三菱総合研究所 20
5月14日 3641 パピレス 12.08
となって、尚且つ
5月14日 3635 コーエーテクモHLDG 10
5月15日 3635 コーエーテクモHLDG 11.55
5月16日 3635 コーエーテクモHLDG 12.07
5月30日 3636 三菱総合研究所 20
5月14日 3641 パピレス 12.08
となることです。
2.更に最終結果は
5月14日 3635 コーエーテクモHLDG 10
5月15日 3635 コーエーテクモHLDG 11.55
5月16日 3635 コーエーテクモHLDG 12.07
5月30日 3636 三菱総合研究所 20
5月14日 3641 パピレス 12.08
5月15日 3641 パピレス 13.64
5月16日 3641 パピレス 15.65
5月15日 3644 1st HLDG 11.89
5月16日 3644 1st HLDG 14.1
となり、
5月15日 3635 コーエーテクモHLDG 11.55
5月16日 3635 コーエーテクモHLDG 12.07
5月15日 3641 パピレス 13.64
5月16日 3641 パピレス 15.65
5月16日 3644 1st HLDG 14.1
が、赤くなってほしいのです。
>ということは番号は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
|
|