Excel VBA質問箱 IV

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

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


8173 / 76736 ←次へ | 前へ→

【74140】Re:条件付き書式
発言  UO3  - 13/4/20(土) 19:34 -

引用なし
パスワード
   ▼nonoka さん:

それでは、基本的に L3 の値は変わらないということを前提に。
(その日、一番にブックを開いたときは昨日の日付とは変わっていますので、そのタイミングでは強制的に処理しますが)

このシートには、様々なイベントルーティンが仕掛けられていると思いますので、それらとの
整合性というか、お互いに悪さをしないように、最終的には、そちらで調整していただくとして
今回の件のみをコードにすれば以下。

ThisWorkbookモジュールに記述してください。

Private Sub Workbook_Open()
  Dim mRow As Long
  With Sheets("Schedule")
    mRow = .UsedRange.Row + .UsedRange.Rows.Count - 1  '最終行番号
    process3 .Range("O10:AA" & mRow)
  End With
End Sub

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
  Dim mRow As Long
  Dim r1 As Range
  Dim r2 As Range
  Dim r3 As Range
  
  If sh Is Sheets("Schedule") Then
    mRow = sh.UsedRange.Row + sh.UsedRange.Rows.Count - 1  '最終行番号
    Set r1 = Intersect(Target, sh.Range("D10:D" & mRow))
    Set r2 = Intersect(Target, sh.Range("M10:M" & mRow))
    Set r3 = Intersect(Target, sh.Range("O10:AA" & mRow))
  End If
  
  If Not r1 Is Nothing Then Call process1(r1)
  If Not r2 Is Nothing Then Call process2(r2)
  If Not r3 Is Nothing Then Call process3(r3)
  
End Sub

Private Sub process1(r As Range)
  Dim c As Range
  r.Interior.ColorIndex = xlNone
  For Each c In r
    If c.Value = ChrW(10003) Then c.Interior.Color = vbRed
  Next
End Sub

Private Sub process2(r As Range)
  Dim c As Range
  Dim myColor As Long
  
  r.Interior.ColorIndex = xlNone
  For Each c In r
    Select Case c.Value
      Case "INS", "SHIP"
        myColor = vbBlue
      Case "CHECK", "URGENT"
        myColor = vbRed
      Case "OG", "RX", "PS", "DYE -D", "DYE - L", "MS", "RC", "DRY", "FS"
        myColor = vbMagenta
    End Select
    If myColor <> 0 Then c.Interior.Color = myColor
  Next
End Sub

Private Sub process3(r As Range)
  Dim c As Range
  Dim sh As Worksheet
  Set sh = r.Parent
  r.Interior.ColorIndex = xlNone
  For Each c In r
    If c.Value = sh.Range("L3").Value Then c.Interior.Color = vbMagenta
  Next
End Sub
0 hits

【74135】条件付き書式 nonoka 13/4/20(土) 11:42 質問
【74136】Re:条件付き書式 UO3 13/4/20(土) 16:36 発言
【74137】Re:条件付き書式 UO3 13/4/20(土) 17:08 発言
【74138】Re:条件付き書式 UO3 13/4/20(土) 18:36 発言
【74139】Re:条件付き書式 nonoka 13/4/20(土) 18:45 回答
【74140】Re:条件付き書式 UO3 13/4/20(土) 19:34 発言
【74141】Re:条件付き書式 UO3 13/4/20(土) 19:40 発言
【74142】Re:条件付き書式 UO3 13/4/20(土) 19:42 発言
【74143】Re:条件付き書式 UO3 13/4/20(土) 19:51 発言

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