エクセルマクロ追加：セルに文字が打っています
- エクセルマクロを使用して、セルに文字が打たれた場合にそのデータ先に移動する方法を実装したいです。
- 現在、セルにデータが打たれると、黒色の文字が使用されていますが、データがある場合には文字の色を変化させる方法を知りたいです。
- 具体的な方法や手順を教えてください。
- ベストアンサー
エクセル マクロ 追加
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 セルに文字が打っています シート名とセルが一緒の文字のとき移動するマクロです データがあるセルをクリックするとそのデータ先に飛ぶように 設定したマクロなのですが、 選択するページの文字は全部最初から設定されている黒文字がつかわれているのですが データがあるときは文字の色を変化させたいのですが どうすればいいでしょうか？
- jikkenn
- お礼率58% (181/310)
- Excel（エクセル）
- 回答数5
- ありがとう数7
- みんなの回答 （5）
- 専門家の回答
質問者が選んだベストアンサー
回答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セルに値のみを貼り付けて下さい。 尚、当然の事ながら、上記の様な置換や貼り付けによって文字色を変えねばならないのは、あくまで既に入力済みとなっているシート名だけであり、新たにシート名を入力する際には、入力しただけで自動的に文字色が変わる様になっております。
その他の回答 (4)
- kagakusuki
- ベストアンサー率51% (2610/5101)
回答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
お礼
色はこれで指定してもできるのですね 今後の参考にさせてもらいます
補足
シートの有無で飛ぶ前のシートのＣ列 の文字色を変更したいのです
- kagakusuki
- ベストアンサー率51% (2610/5101)
確認したい点が御座います。 >シート名とセルが一緒の文字のとき移動するマクロです > データがあるセルをクリックするとそのデータ先に飛ぶように設定したマクロ との事ですが、御質問文中に記されている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
補足
遅くなりもしわけありません 説明不足ですみません 押すセルはＣ２、３，５，６、８，９，１１，１２，１４，１５ だけです ほかのセルで同じ名前などでは反応しないようにしたいのです Ｃ２ 氏名 と記載していた場合 シート名の 氏名 に移動する。 Ｃ４とかで 氏名 と記載していても ただのデータとみて反応しない 上記のセル番号のみ固定で文字が入力しています 他は保護をかけて触れないようにしています 飛ぶ前のページにＣ２とかに氏名などと記載しておき 氏名シートがあるときは色を変更（赤など） 飛ぶ先がなければ色は最初のまま（黒） にしておきたいのです
- kkkkkm
- ベストアンサー率65% (1606/2443)
No1の追加です。 もし、データの有無を判定するセルが複数になる場合に(データがあっても単一のセルに必ずあるとは限らない場合)は たとえばA1からA10までとした場合 それぞれ以下のようにしてください。 マクロ If WorksheetFunction.CountIf(Worksheets(Target.Value).Range("A1:A10"), "<>" & "") > 0 Then 条件付き書式 =COUNTIF(Sheet6!A1:A10,"<>" & "")>0
- kkkkkm
- ベストアンサー率65% (1606/2443)
データがどこに入力されているのかわからないのでデータ先の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<>"" として書式の文字色を設定しておいてください。
関連するQ&A
- エクセル マクロ 追加したいのですが・・
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address = "$A$2" Or Target.Address = "$A$3" Or Target.Address = "$A$5" _ Or Target.Address = "$A$6" Or Target.Address = "$A$8" Or Target.Address = "$A$9" _ Or Target.Address = "$A$11" Or Target.Address = "$A$12" Or Target.Address = "$A$13" Then Worksheets(Target.Value).Visible = True Worksheets(Target.Value).Select Else End If End Sub これで選択するとシートに飛ぶようにしているのですが 記載がまだのところもあり、空白の時 押してしまうとエラーが出てしまいます 空白の時は反応しないようにしたいのですが どうすればいいでしょうか？
- ベストアンサー
- Excel（エクセル）
- エクセル マクロ
Ｃ１５に="田中"&TEXT(A15,"ｍ.d") Ｃ１５に田中8.31と表示されてます 別のシート作成し 田中8.31 と名前を付けておきます Ｃ１５を押した時に飛ぶように設定しようとしたのですが うまくいかないのですが どうしたらいいでしょうか？ Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address = "$C$14" Or Target.Address = "$C$15" Then Worksheets(Target.Value).Visible = True Worksheets(Target.Value).Select Else End If End Sub Worksheets(Target.Value).Visible = True ここの部分でうまくいかなくなります
- ベストアンサー
- Excel（エクセル）
- エクセル マクロ 修正
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address = "$C$1" Then ActiveSheet.Visible = False Worksheets("月").Activate End If 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 選択したら飛ぶようにしているのですが 例えばC１４の名前や飛ぶ先のシートを消した際に エラーが出ます。 名前が違う場合やシートがない場合は選択しても 無反応にしたいのですが どのようなプログラムを追加したらいいでしょうか？
- ベストアンサー
- Excel（エクセル）
- Excelのマクロで、IFを複数セルに指定するには
セルA1、B1、C1をダブルクリックすると各セルの値が+1ずつ増える Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address = "$A$1" Then Target.Value = Target.Value + 1: Cancel = True If Target.Address = "$B$1" Then Target.Value = Target.Value + 1: Cancel = True If Target.Address = "$C$1" Then Target.Value = Target.Value + 1: Cancel = True End Sub というマクロを使用致しておりますが、これに追加で セルA1をダブルクリックした時に、A1と同時にセルC1も＋１増やせる 方法があれば教えて頂けると幸いです。 宜しくお願い致します。
- ベストアンサー
- Excel（エクセル）
- エクセルのマクロ
セルの値が変わったら動くマクロですが、2つ書くとエラーが出ます。 どのように直したらいいでしょうか？ Private Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Address If Intersect(Target, Range("EK22")) Is Nothing Then Exit Sub Else Range("EK24:EM28").Select Selection.ClearContents End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("EK24")) Is Nothing Then Exit Sub Else Range("EK27:EM28").Select Selection.ClearContents End If End Sub
- ベストアンサー
- Excel（エクセル）
- このマクロあっていますでしょうか？よろしくお願いいたします。
★sheetＡ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$C$14" And Target.Address <> "$C$19" _ And Target.Address <> "$F$19" Then Exit Sub If Target.Address <> "$R$14" And Target.Address <> "$S$14" _ And Target.Address <> "$T$19" Then Exit Sub Application.EnableEvents = False With Sheets("Ｂ") .Range("F14").Value = Range("C14").Value .Range("F17").Value = Range("C19").Value .Range("F20").Value = Range("F14").Value .Range("F23").Value = Range("F19").Value End With With Sheets("Ｃ") .Range("F13").Value = Range("R14").Value .Range("F14").Value = Range("S14").Value .Range("F18").Value = Range("T19").Value End With Application.EnableEvents = True End Sub ★sheetＢ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$F$14" And Target.Address <> "$F$17" _ And Target.Address <> "$F$23" Then Exit Sub Application.EnableEvents = False With Sheets("Ａ") .Range("C14").Value = Range("F14").Value .Range("C19").Value = Range("F17").Value .Range("F19").Value = Range("F23").Value End With Application.EnableEvents = True End Sub ★sheetＣ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$F$13" And Target.Address <> "$F$14" _ And Target.Address <> "$F$18" Then Exit Sub Application.EnableEvents = False With Sheets("Ａ") .Range("R14").Value = Range("F13").Value .Range("S14").Value = Range("F14").Value .Range("T19").Value = Range("F18").Value End With Application.EnableEvents = True End Sub
- ベストアンサー
- オフィス系ソフト
- マクロコードの変更
以下のサンプルコードをネットでみつけました。 "D$7"セルに入れた文字と同じ文字を見つけてセルを移動させてくれるコードだと思いますが 私のエクセル表はD7セルに６桁の数字（111101）を入れますが 検索先は'111101とシングルコーテーションが入っています。 サンプルコードのD7セルのところをどのように変更したらいいでしょうか。 Private Sub Worksheet_Change(ByVal Target As Range) Dim myR As Range If Target.Address <> "$D$7" Then Exit Sub If Target.Value = "" Then Exit Sub Set myR = Cells.Find(What:=Target.Value, _ After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlWhole, SearchOrder:=xlByRows, _ SearchDirection:=xlNext, MatchCase:=True) If myR.Address = Target.Address Then MsgBox "同じ値はありません" Else myR.Activate End If End Sub どうぞよろしくおねがいします。
- ベストアンサー
- Excel（エクセル）
- エクセルのマクロコードについて
お世話になります。 下記コードで、セルごとにクリアをすると、エラーなくうごくのですが、セルをまとめてセルを消すと実行時エラー13型が一致しません。とでてIf Target.Value = "" Thenがだめだよとでてしまいます。 どなたか、回避の方法をご教授ください。 宜しくお願いいたします。 Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("B2:E2,G2:J2")) Is Nothing Then Exit Sub If Target.Value = "" Then Exit Sub x = Target.Value With Application .ScreenUpdating = False .EnableEvents = False .Undo 'Range("B2").Value = x + Z Z = Target.Offset(1, 0).Value y = Target.Value Target.Value = x + y .EnableEvents = True .ScreenUpdating = True End With Target.Offset(1, 0).Value = x + Z End Sub
- ベストアンサー
- Excel（エクセル）
- このマクロの意味を教えて下さい。
条件付き書式の色付けで「指定した文字を含む」という条件を ４つ以上つくるということで、下のマクロを探してきたんですが、少しでも意味を 知りたいです。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 1 Then Exit Sub If Selection.Count > 1 Then Exit Sub x = Target.Value c = 0 If x Like "*あ*" Then c = 6 If x Like "*い*" Then c = 4 If x Like "*う*" Then c = 34 If x Like "*え*" Then c = 3 Target.Interior.ColorIndex = c End Sub これを実行したんですが、なぜ結合したセルの場合だけ、文字を 削除した際に色が残るのですか？ それを指示している部分と改善策を教えて下さい。
- ベストアンサー
- オフィス系ソフト
- エクセルのコード表示についてですが。。
Private Sub Worksheet_Change(ByVal Target As Range) (1)If Target.Column <> 4 Then Exit Sub Target.Offset(0, -3) = Now() ⇒特定のセルに日時自動表示 (2)If Target.Column <> 4 Then Exit Sub Target.Offset(0, 1) = "DUMMY" ⇒特定のセルにDUMMYと自動表示 (3)If Target.Column = 4 Then Target.Offset(0, -2) = "1" Else ⇒特定のセルに１と自動表示 (4)If Target.Column = 35 Then Target.Offset(0, -2) = "2" ⇒特定のセルに２と自動表示 End If End If (5)If Target.Value = "T" Or Target.Value = "t" Then Target.Value = "田中" ⇒Tと入力すると田中と変換して表示 ElseIf Target.Value = "H" Or Target.Value = "h" Then Target.Value = "林" ⇒ｈと入力すると林と変換して表示 End If End Sub 上のようなコードを入力すると(3)と(5)が機能しません。。なぜでしょうか？？コードの表示がまずいのでしょうか？？
- 締切済み
- その他([技術者向] コンピューター)
お礼
詳しい説明まで ありがとうございます 非常に助かります。 無事にできました 毎回ありがとうございます。