Excel VBA質問箱 IV

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

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


20606 / 76732 ←次へ | 前へ→

【61540】Re:特定のセルと一致すれば色を変える
発言  つん  - 09/5/15(金) 15:22 -

引用なし
パスワード
   どもども

なんとなく、HAMさんのやり方の方がいいかもな?という気もしますが、
(If .Value = Cells(1, 5) Then .Interior.ColorIndex = 7 '
 ここんとこ  ↑Cells(2,5)ですね^^)

チロさんが、「Worksheet_Change」でしてはったんで、
それでしてみました。

'==============================================
Private Sub Worksheet_Change(ByVal Target As Range)

  Dim r As Range
  Dim r2 As Range
  
  Set r2 = Intersect(Target, Range("e2:h2"))
  'セル色変更入力で重複を防ぐ
    If Not r2 Is Nothing Then
      For Each r In Range("e2:h2")
        If r.Address <> Target.Address And r.Value = Target.Value Then
          MsgBox "値が重複しています"
          Application.EnableEvents = False
          Target.Value = ""
          Application.EnableEvents = True
          Exit Sub
        End If
      Next r
    End If
    
  Set r2 = Intersect(Target, Range("j2:l4", "n2:q5"))
  '文字色変更入力で重複を防ぐ
    If Not r2 Is Nothing Then
      For Each r In Range("j2:l4", "n2:q5")
        If r.Address <> Target.Address And r.Value = Target.Value Then
          MsgBox "値が重複しています"
          Application.EnableEvents = False
          Target.Value = ""
          Application.EnableEvents = True
          Exit Sub
        End If
      Next r
    End If
  
  Select Case Target.Address(0, 0)
    Case "E2"
      Call subIroIro(Target, 7, True)
    Case "F2"
      Call subIroIro(Target, 46, True)
    Case "G2"
      Call subIroIro(Target, 6, True)
    Case "H2"
      Call subIroIro(Target, 4, True)
    Case "J2", "J3", "J4", "K1", "K2", "K3", "L2", "L3", "L4"
      Call subIroIro(Target, 3, False)
    Case "N2", "N3", "N4", "N5", "O2", "O3", "O4", "O5", "P2", "P3", "P4", "P5", "Q2", "Q3", "Q4", "Q5"
      Call subIroIro(Target, 5, False)
  End Select
  
  Set r2 = Nothing
  
End Sub

'==============================================
Sub subIroIro(arg_rTarget As Range, arg_lngIro As Long, arg_blnFlag As Boolean)
'arg_rTarget 入力したセル
'arg_lngIro 設定する色
'arg_blnFlag セル(True)か文字(False)か

  Dim rHit As Range
  Dim strAddress As String
  
  With Range("E11:AH74")
  
    Set rHit = .Find(arg_rTarget.Value, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not rHit Is Nothing Then
      strAddress = rHit.Address
      Do
        Select Case arg_blnFlag
          Case True
            rHit.Interior.ColorIndex = arg_lngIro
          Case False
            rHit.Font.ColorIndex = arg_lngIro
        End Select
        Set rHit = .FindNext(rHit)
      Loop While Not rHit Is Nothing And rHit.Address <> strAddress
    End If
  
  End With

End Sub
'==============================================

一応、セル色変更、文字色変更のくくりで重複しないように処理しましたが、
削除された時とか、他にたくさん問題ありそう^^;

参考にでもなれば^^

0 hits

【61535】特定のセルと一致すれば色を変える チロ 09/5/14(木) 22:40 質問
【61537】Re:特定のセルと一致すれば色を変える つん 09/5/15(金) 9:55 発言
【61538】Re:特定のセルと一致すれば色を変える HAM 09/5/15(金) 11:18 発言
【61540】Re:特定のセルと一致すれば色を変える つん 09/5/15(金) 15:22 発言
【61546】Re:特定のセルと一致すれば色を変える チロ 09/5/15(金) 20:55 お礼

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