エクセル マクロ 追加

質問

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then
Exit Sub
End If
If Not Intersect(Target, Range("B1:C15")) Is Nothing And Target.Value = "" Then
Exit Sub
End If
Dim c As Worksheet
Dim flag As Boolean
flag = False
For Each c In Worksheets
If c.Name = Target.Value Then flag = True
Next
If flag = False Then Exit Sub
If Target.Address = "$C$2" Or Target.Address = "$C$3" Or Target.Address = "$C$4" _
Or Target.Address = "$C$5" Or Target.Address = "$C$6" Or Target.Address = "$C$7" _
Or Target.Address = "$C$8" Or Target.Address = "$C$9" Or Target.Address = "$C$10" _
Or Target.Address = "$C$11" Or Target.Address = "$C$12" Or Target.Address = "$C$13" _
Or Target.Address = "$C$14" Or Target.Address = "$C$15" Then
Worksheets(Target.Value).Visible = True
Worksheets(Target.Value).Select
Else
End If
End Sub

セルに文字が打っています
シート名とセルが一緒の文字のとき移動するマクロです

データがあるセルをクリックするとそのデータ先に飛ぶように
設定したマクロなのですが、
選択するページの文字は全部最初から設定されている黒文字がつかわれているのですが
データがあるときは文字の色を変化させたいのですが
どうすればいいでしょうか？

回答No.5

kagakusuki · ベストアンサー

回答No.3、4です。

>押すセルはＣ２、３，５，６、８，９，１１，１２，１４，１５だけです
>ほかのセルで同じ名前などでは反応しないようにしたいのです

　つまり、御質問文中にある質問者様が作られたVBAの構文の

If Target.Address = "$C$2" Or Target.Address = "$C$3" Or Target.Address = "$C$4" _
Or Target.Address = "$C$5" Or Target.Address = "$C$6" Or Target.Address = "$C$7" _
Or Target.Address = "$C$8" Or Target.Address = "$C$9" Or Target.Address = "$C$10" _
Or Target.Address = "$C$11" Or Target.Address = "$C$12" Or Target.Address = "$C$13" _
Or Target.Address = "$C$14" Or Target.Address = "$C$15" Then

というのは間違いで、C4,C7,C10,C13セルは、この御質問の件における

>データがあるセル
からは除外するという事なのですね。
　後、前回の回答においては

>データがあるときは文字の色を変化

させる場合の色の指定がなかったため、取り敢えず文字色を青にしておいたのですが、

>氏名シートがあるときは色を変更（赤など）

という事は文字色を青ではなく赤にした方が良いという事なのですね。
　それでしたら以下の様なVBAとなります。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Count > 1 Or Intersect(Target, Range("2:3,5:6,8:9,11:12,14:15"), Columns("C")) Is Nothing Then Exit Sub
If Not IsError(Evaluate("ROW('" & Target.Value & "'!A1)")) Then
With Sheets(Target.Value)
.Visible = True
.Select
End With
End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

Dim c As Range, myRange As Range

Set myRange = Intersect(Target, Range("2:3,5:6,8:9,11:12,14:15"), Columns("C"))
If myRange Is Nothing Then Exit Sub
For Each c In myRange
If IsError(Evaluate("ROW('" & c.Value & "'!A1)")) Then
c.Font.ColorIndex = xlAutomatic
Else
c.Font.Color = vbRed
End If
Next c

End Sub

　尚、

>シートの有無で飛ぶ前のシートのＣ列の文字色を変更したいのです

という点に関しては、回答No.4において既に実現しており、単に入力されている文字色を変更する対象となるセルの範囲が変更前のものであるという点と、文字色の色が今回新たに指定したものとなっているというだけで、基本的な処理は回答No.4から変わっておりません。
　但し、文字色が変更されるのはあくまで新たに入力した文字列だけですので、もし既に入力済みとなっているシート名まで色を変更したいという事であれば、2つの方法があります。
　1つ目の方法はC2:C15のセル範囲をまとめて選択してから、Excelの置換機能を使用して、例えば「Sheet○○」や「Sheet××」の「S」の様に、各シート名に共通する文字を「検索と置換」ダイアログボックスの[置換]タブの「検索する文字列」欄と「置換後の文字列」欄の両方に入力してから、[すべて置換]ボタンをクリックして下さい。
　もし、全てのセルに共通する文字が存在しない場合には、1回目の置換では置換対象とはならなかったセル同士の中でもう一度共通する文字を見つけて置換を行う、という具合に複数回に分けて置換を繰り返して下さい。
　2つ目の方法は、C2:C15のセル範囲をまとめてコピーし、一旦、別のセル範囲(別シート上のセル範囲でも可)に値のみを貼り付けた後、元のシートのC2:C15のセル範囲に入力されている値を一旦消去してから、先述の「C2:C15のセル範囲の値をコピーしておいた別のセル範囲」をまとめてコピーし、C2セルに値のみを貼り付けて下さい。

　尚、当然の事ながら、上記の様な置換や貼り付けによって文字色を変えねばならないのは、あくまで既に入力済みとなっているシート名だけであり、新たにシート名を入力する際には、入力しただけで自動的に文字色が変わる様になっております。

お礼

詳しい説明まで
ありがとうございます
非常に助かります。

無事にできました
毎回ありがとうございます。

回答No.4

kagakusuki

回答No.3です。

　それとも、

>データがあるときは文字の色を変化させたいのですが

とは、
「セルをクリックした時に、そのセルに入力されている文字に対してのみ、色を変化させる様する」
のではなく
「C2～C15のセル範囲内のセルの内の何れかのセルの値が変更された際に、その値が変更されたセルに入力されている文字に対してのみ、色を変化させる様する」
という事なのでしょうか？
　もしそうであれば次の様なVBAのマクロとなります。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Count > 1 Or Intersect(Target, Range("C2:C15")) Is Nothing Then Exit Sub
If Not IsError(Evaluate("ROW('" & Target.Value & "'!A1)")) Then
With Sheets(Target.Value)
.Visible = True
.Select
End With
End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

Dim c As Range

If Intersect(Target, Range("C2:C15")) Is Nothing Then Exit Sub
For Each c In Intersect(Target, Range("C2:C15"))
If IsError(Evaluate("ROW('" & c.Value & "'!A1)")) Then
c.Font.ColorIndex = xlAutomatic
Else
c.Font.Color = vbBlue
End If
Next c

End Sub

お礼

色はこれで指定してもできるのですね
今後の参考にさせてもらいます

補足

シートの有無で飛ぶ前のシートのＣ列
の文字色を変更したいのです

回答No.3

kagakusuki

確認したい点が御座います。

>シート名とセルが一緒の文字のとき移動するマクロです
> データがあるセルをクリックするとそのデータ先に飛ぶように設定したマクロ

との事ですが、御質問文中に記されているVBAでは

Worksheets(Target.Value).Select

という処理へ進むのは、

If Target.Address = "$C$2" Or Target.Address = "$C$3" Or Target.Address = "$C$4" _
Or Target.Address = "$C$5" Or Target.Address = "$C$6" Or Target.Address = "$C$7" _
Or Target.Address = "$C$8" Or Target.Address = "$C$9" Or Target.Address = "$C$10" _
Or Target.Address = "$C$11" Or Target.Address = "$C$12" Or Target.Address = "$C$13" _
Or Target.Address = "$C$14" Or Target.Address = "$C$15" Then

の判定がTrueである場合だけとなっているという事は、この御質問の件における

>データがあるセル

とは、C2～C15のセル範囲内のセルにのみ限定していて、例えB1セルなどの「C2～C15のセル範囲以外のセル」にシート名と同じ値が入力されていたとしても、C2～C15のセル範囲外であるため、そのセル(例えばB1セル)をクリックしても他のシートには飛ばない様にしたいという御要望だと考えれば宜しいのでしょうか？

　それから、

>データがあるときは文字の色を変化させたいのですが

とは、どの文字の色をいつ変化させる様にすれば宜しいのでしょうか？
　セルをクリックした時に、そのセルに入力されている文字に対してのみ、色を変化させる様にすれば宜しいのでしょうか？

　もし、上記した2点通りの御要望であるとすれば、次の様なVBAのマクロとなります。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Count > 1 Or Intersect(Target, Range("C2:C15")) Is Nothing Then Exit Sub
If IsError(Evaluate("ROW('" & Target.Value & "'!A1)")) Then
Target.Font.ColorIndex = xlAutomatic
Else
Target.Font.Color = vbBlue
With Sheets(Target.Value)
.Visible = True
.Select
End With
End If

End Sub

補足

遅くなりもしわけありません
説明不足ですみません
押すセルはＣ２、３，５，６、８，９，１１，１２，１４，１５
だけです
ほかのセルで同じ名前などでは反応しないようにしたいのです
Ｃ２　氏名　と記載していた場合
シート名の　氏名　に移動する。
Ｃ４とかで　氏名　と記載していても　ただのデータとみて反応しない
上記のセル番号のみ固定で文字が入力しています
他は保護をかけて触れないようにしています

飛ぶ前のページにＣ２とかに氏名などと記載しておき
氏名シートがあるときは色を変更（赤など）
飛ぶ先がなければ色は最初のまま（黒）
にしておきたいのです

回答No.2

kkkkkm

No1の追加です。

もし、データの有無を判定するセルが複数になる場合に(データがあっても単一のセルに必ずあるとは限らない場合)は
たとえばA1からA10までとした場合
それぞれ以下のようにしてください。
マクロ
If WorksheetFunction.CountIf(Worksheets(Target.Value).Range("A1:A10"), "<>" & "") > 0 Then

条件付き書式
=COUNTIF(Sheet6!A1:A10,"<>" & "")>0

回答No.1

kkkkkm

データがどこに入力されているのかわからないのでデータ先のA1だとして、データ先に飛んだ後にページの文字を変化させるのでしたら(希望する動作と異なると思いますが)
Worksheets(Target.Value).Select
の後に以下を追加してください。
If Worksheets(Target.Value).Range("A1").Value <> "" Then
Target.Font.ColorIndex = 4
Else
Target.Font.ColorIndex = xlAutomatic
End If

色の番号は以下のページを参考にしてください。
http://www.relief.jp/itnote/archives/000482.php

クリックする前にデータがあるかどうかで色を付けたいのでしたら条件付き書式で設定したほうがいいと思います。
たとえばC2のデータ先がSheet6でデータの有無をA1で確認するのでしたらC2セルの条件付き書式を
次の数式を満たす・・・
=Sheet6!A1<>""
として書式の文字色を設定しておいてください。