|    | 
     ▼本山中 さん: 
 
ということは番号は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 
 | 
     
    
   |