数式結果で色分けをしたい

質問

以下の設定により、セルの内容によって色分けするように設定しています。また、セルには数式を入れており、ＩＦ式を使用して、他のセルの値によって"◎"や"×"などを表示するようにしてします。が、セルの表示が切り替わっても色が替わりません。ちなみに、数式をコピペするとちゃんと色分けされます。数式が参照するセルの内容が変わったと同時に色が変わるようにするにはどうすればいいのでしょうか？どなたか詳しい方教えてください。宜しくお願いします。

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 17 Then
x = Target.Value
c = 0
If x Like "◎" Then c = 33
If x Like "○" Then c = 6
If x Like "△" Then c = 3
If x Like "×" Then c = 1
Target.Interior.ColorIndex = c
End If
End Sub

回答No.5

zap35 · ベストアンサー

例えばこんなマクロでも可能でしょう

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng, r As Range
Set rng = Intersect(Columns(17), Target.EntireRow)
If Not rng Is Nothing Then
　　For Each r In rng
　　　　Select Case r.Value
　　　　Case Is = "◎"
　　　　　　r.Interior.ColorIndex = 33
　　　　Case Is = "○"
　　　　　　r.Interior.ColorIndex = 6
　　　　Case Is = "△"
　　　　　　r.Interior.ColorIndex = 3
　　　　Case Is = "×"
　　　　　　r.Interior.ColorIndex = 1
　　　　Case Else
　　　　　　r.Interior.ColorIndex = xlNone
　　　　End Select
　　Next r
End If
End Sub

お礼

有り難うございます。教えて頂いた方法で解決できました。

回答No.4

don9don9

No.3です。

ではループの仕方を変えてみてください。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Integer
Dim n As Integer
Dim x As String

For n = 1 to 100 '1行目から100行目まで
x = Cells(n, 17)
c = 0
Select Case x
Case "◎": c = 33
Case "○": c = 6
Case "△": c = 3
Case "×": c = 1
Case Else: c = 0
End Select
If c <> 0 Then
Cells(n, 17).Interior.ColorIndex = c
End If
Next n
End Sub

お礼

おかげさまで解決できました。有り難うございました。

回答No.3

don9don9

IFを使って◎、○、△、×を出力している列が17列目なのですね？
一例ですが、以下でどうでしょうか。
ワークシートの内容が変更される度に、1行目から順に
17列目の内容を見て色をつける。
17列目が空白になったら終了。

但し注意点として以下の場合は使わないで下さい。
・データが何千件、何万件もある
→1行変更するごとに全行チェックがかかるので
　非常に負荷がかかります。
・データの途中に空白行がある
→「17列目を上から順に見て、空白なら終了」ですので
　途中に空白行があるとそこで止まってしまいます。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Integer
Dim n As Integer
Dim x As String

n = 1　'←これは開始行です。任意で変更して下さい。
Do Until Cells(n, 17) = ""
x = Cells(n, 17)
c = 0
Select Case x
Case "◎": c = 33
Case "○": c = 6
Case "△": c = 3
Case "×": c = 1
Case Else: c = 0
End Select
If c <> 0 Then
Cells(n, 17).Interior.ColorIndex = c
End If
n = n + 1
Loop
End Sub

補足

回答有り難うございます。

注意点に書いてある「空白がある」に該当します。
空白がある場合の対処方法があるようでしたら教えてください。

回答No.2

okormazd

これだけではよくわからないが、たぶん、

Worksheet_Changeイベントは、数式で計算結果が変わってもイベントが起こらない。
これでイベントを取りたいならWorksheet_Calculateイベントを使う。

補足

回答有り難うございます。

Worksheet_Calculateイベントに上記構文を入力して試してみましたが、実行時エラー「オブジェクトが必要です」と表示され、上手く動作しません。対処方法は有るでしょうか？

回答No.1

hallo-2007

よくわかりませんが
>ＩＦ式を使用して、他のセルの値によって"◎"や"×"などを表示するようにしてします
なので、変更したときの列が17(Target.Column = 17 )でないのでは？
Target.Valueは、IF文の先のセルですので、○でも◎にもならない。

お礼

回答有り難うございました。