プロが教えるわが家の防犯対策術!

以下のプログラムを使用していますが、プログラムの有効範囲をコピペして増やそうとすると、
「実行事例外13・型の不一致」というメッセージが出てしまいます。
記述に間違っている箇所はないと思うのですが、本件につきまして改善点をご教示いただけると幸いです。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
Const trg As String = "A1:ZZ1000"
Set Rng = Intersect(Target, Range(trg))
If Not Rng Is Nothing Then
Select Case Rng.Value

Case Is = "犬", "猫", "A"
Rng.Interior.ColorIndex = 7

Case Is = "淡水魚", "海水魚", "B"
Rng.Interior.ColorIndex = 44

Case Is = "牧草", "芝", "C"
Rng.Interior.ColorIndex = 8

Case Else 'その他の値なら色を消す
Rng.Interior.ColorIndex = xlNone
End Select
End If
End Sub

A 回答 (1件)

コピーすると、Target のセルが複数(コピーした分)になります。


よって今回は1つのセルごとに対応しなくてはならないのでエラーになります。
※Select Case Rng.Valueの「Rng」が複数のセルなので値が取得できません。

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rng   As Range
 Dim 複数Rng As Range

 Const trg As String = "A1:ZZ1000"
 Set 複数Rng = Intersect(Target, Range(trg))
 If 複数Rng Is Nothing Then Exit Sub

 For Each Rng In 複数Rng
  Select Case Rng.Value
   Case Is = "犬", "猫", "A"
    Rng.Interior.ColorIndex = 7
   Case Is = "淡水魚", "海水魚", "B"
    Rng.Interior.ColorIndex = 44
    Case Is = "牧草", "芝", "C"
    Rng.Interior.ColorIndex = 8
    Case Else 'その他の値なら色を消す
    Rng.Interior.ColorIndex = xlNone
  End Select
 Next
End Sub
    • good
    • 0
この回答へのお礼

jcctaira様

この度はご教示ありがとうございました。
大変助かりました。

お礼日時:2016/09/22 13:16

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!