| |
どもども
なんとなく、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
'==============================================
一応、セル色変更、文字色変更のくくりで重複しないように処理しましたが、
削除された時とか、他にたくさん問題ありそう＾＾；
参考にでもなれば＾＾
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
