Excel VBA質問箱 IV

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

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


10173 / 76734 ←次へ | 前へ→

【72112】Re:ステートメントを教えてください
発言  UO3  - 12/5/30(水) 12:17 -

引用なし
パスワード
   ▼本山中 さん:

ということは番号は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
6 hits

【72108】ステートメントを教えてください 本山中 12/5/30(水) 10:29 質問
【72109】Re:ステートメントを教えてください UO3 12/5/30(水) 11:14 発言
【72110】Re:ステートメントを教えてください UO3 12/5/30(水) 11:21 発言
【72111】Re:ステートメントを教えてください 本山中 12/5/30(水) 11:58 発言
【72112】Re:ステートメントを教えてください UO3 12/5/30(水) 12:17 発言
【72113】Re:ステートメントを教えてください 本山中 12/5/30(水) 13:53 発言
【72116】Re:ステートメントを教えてください UO3 12/5/30(水) 20:09 発言
【72119】Re:ステートメントを教えてください 本山中 12/5/31(木) 5:55 お礼
【72114】Re:ステートメントを教えてください ドカ 12/5/30(水) 17:29 発言
【72115】Re:ステートメントを教えてください ドカ 12/5/30(水) 17:56 発言

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