• ベストアンサー

エクセルのVBAで条件付でフォントを変更したいのですが

たとえばD19のセルには他のセルに入力された文字数が表示されるようLEN(C19)といったような関数が入力されています。D19の値が20より大きければE19のフォントは20にそれ以外なら11にしたいとします。 ちなみにE19も関数が入力さています。 下記でよいのかなと思ったのですが・・・ 直接数値を入力する場合はちゃんと動くのですがD19が数式になるとうまく行きません。どなたか教えてください。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$D$19" Then If Target.Value > 20 Then Range("E19").Font.Size = 20 Else Range("E19").Font.Size = 11 End If End If End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • picklse
  • ベストアンサー率65% (26/40)
回答No.1

「If Target.Address = "$D$19" Then」の部分で、Worksheet_Changeイベントが発生した原因のセルがD19の場合に処理を行うようになっています。このため、D19に直接入力をした場合だけに期待の動作をするようになります。 ですから、Target.Addressには、D19の値を計算する元ととなるデータを入力するセルの番地を入力することになります。 また、次のようなコードにすると、イベントの発生原因となったセルは特定されません。 Private Sub Worksheet_Change(ByVal Target As Range) If Range("D19").Value > 20 Then Range("E19").Font.Size = 20 Else Range("E19").Font.Size = 11 End If End Sub

beagle61
質問者

お礼

ありがとうございました。Target.Address の意味がきちんと理解できてませんでした。おかげで解決しました。

その他の回答 (1)

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

こんにちは。 たぶん、こういうことではないかと思います。 >直接数値を入力する場合はちゃんと動くのですがD19が数式になるとうまく行きません。 Calculate イベントを使うと、うっとうしくてしょうがないので、以下のように、Precedents を使いますが、状況によって、DirectPrecedents でもよいと思います。 エラートラップで挟むのは、D19に数式がない場合をも想定しています。#1さんのおっしゃるように、直接、数式を変化させる[入力するセル]を指定するのが、正しい方法だと思います。 Private Sub Worksheet_Change(ByVal Target As Range)   Dim r As Range   On Error Resume Next   Set r = Intersect(Target, Range("D19").DirectPrecedents)   On Error GoTo 0   If Not r Is Nothing Then     Application.EnableEvents = False     If Range("D19").Value > 20 Then       Range("E19").Font.Size = 20     Else       Range("E19").Font.Size = 11     End If     Application.EnableEvents = True   End If End Sub

beagle61
質問者

お礼

ありがとうございます。今回は数式がないということは発生しないのですがこのようにすれば数式がない場合も対応できるのですね。今後の参考にしたいとおもいます。

関連するQ&A

  • エクセルのVBAで条件付でフォントを変更したいのですがその2

    前回、教えていただきD19に関数が入っていてもきちんと動くようになったのですが同じシート内の入力によってD19の計算結果が表示されるときには良いのですが別のシートの入力内容をD19が参照する時にはうまくゆきません。自動記録されたマクロの内容を手直しするレベルの私にはここまでくるとどうして良いのかさっぱりです。どなたか助けてください。 Private Sub Worksheet_Change(ByVal Target As Range) If Range("D19").Value > 20 Then Range("E19").Font.Size = 20 Else Range("E19").Font.Size = 11 End If End Sub

  • EXCEL VBAについて教えてください

    はじめまして。 過去ログに私のやりたいような内容を探していたらこのような下記のエクセルVBAがあったので、教えて頂きたいです。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$A$1" Then Exit Sub If Target.Value = "" Then Exit Sub x = Target.Value With Application .ScreenUpdating = False .EnableEvents = False .Undo y = Target.Value Target.Value = x + y .EnableEvents = True .ScreenUpdating = True End With With Cells(ActiveSheet.Rows.Count, "C").End(xlUp) .Offset(1, 0).Value = x .Offset(1, 1).Value = Time() End With End Sub A1に入力するたびに同一セルに加算。 A1をクリアできる。 C列に入力履歴、D列に入力時間を記録。 If Target.Address <> "$A$1" Then Exit Sub の$A$1を変えることによって他のセルにも設定できる。 と、いう内容なのですが、これをたとえば同一シートのA1~E10のセルとA12~E22にも同じよう別々に処理できるように設定したいのですが、どのようにすればいいのでしょうか?ちなみにA11~E11とA23~E23は合計を表示するセルにしたいです。 Excelのバージョンは2003です。 よろしくお願い致します

  • マクロ コピー&ペーストで書式が変わる

    特定列のセルに入力があれば、文字数で書式を変更するコードを書きました。 リストから選択や手入力なら問題ないですが、コピー&ペーストだと、うまくいきません。 ペーストでも問題なく起動するコードはありますか? 【やりたい事】 特定の文字を入力→〇文字未満なら折り返し解除、縮小して全体表示、文字大きさ11。〇文字以上なら折り返して文字大きさ7で表示。 【現状】 コピー&ペーストだと、ペーストだと、文字フォント7で縮小して全体表示になってしまう。 コード Private Sub Worksheet_Change(Byval Target As Range) If Not Intersect(Target, Range(”AE:AE”)) Is Nothing Then If Len(Target.Value) < 8 Then Target.WrapText = False Target.ShrinkToFit = True Target.Font.Size = 11 ElseIf Len(Target.Value) >= 8 Then Target.WrapText = True Target.ShrinkToFit = False Target.Font.Size = 7 Else Exit Sub End If ElseIf Not Intersect(Target, Range(”AI:AI”)) Is Nothing Then If Len(Target.Value) < 5 Then Target.WrapText = False Target.ShrinkToFit = True Target.Font.Size = 11 ElseIf Len(Target.Value) >= 5 Then Target.WrapText = True Target.ShrinkToFit = False Target.Font.Size = 7 Else Exit Sub End If End Sub

  • エクセルVBAのイベントについて教えてください。

    エクセルVBA初学者のです。 "C9"にいれるとchangeイベントが発生するコードなんですが、 "C9"のほかに"D1"においてもchangeイベントを発生させたいのですが 下記のコードに続けて書いてもイベントが発生しないのですが どのように書けばよいのでしょうか? private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("C9")) Is Nothing Then Exit Sub Range("H14:H56").Interior.ColorIndex = 2 If Intersect(Target, Range("D1")) Is Nothing Then Exit Sub Range("G14:G56").Interior.ColorIndex = 2 End Sub よろしくお願いします。

  • エクセルで任意の順番にて入力をしたいのですが・・・

    エクセルで任意の順番にて入力(テンキー使用でenterで移動)をしたいです。 自分で調べてやったのですがうまくできないので教えてください。 ctrlキー+セル選択で名前BOXに登録は、セルを40個ほどしか登録できない?でしょうか・・・? 全部で300個ほど有るのですが、ちまちまやっても40個くらいのところで先頭に戻ります。 何か他の設定がおかしいのでしょうか? マクロも簡単そうなやつ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then Range("D10").Select End If End Sub をやってみました。 今一解らず、 If Target.Address = "$A$1" Then Range("D10").Select End If のセルの位置を変えてやりましたが、こちらも数に制限があるのか 全部を登録して順番どうりに入力することができません。 数個分の枠で妙な位置に移動します・・・ 中の式を複数作ってやりました・・・ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then Range("D10").Select       ・       ・       ・ If Target.Address = "XXXX" Then Range("XXX").Select End If End Sub ($A$1とD10の値を変えたものを多数使用して・・・) 何か良い方法があれば教えてください。 よろしくお願いします。

  • EXCELマクロでのシート間のデータ同期方法

    質問させていただきます。 EXCELにて、"シート1"のA1~C3と"シート2"のD4~F6を 同期化したく考えております。 ・いわゆる一方のシートが「読み取り専用」になってしまうリンク貼り付けではなく、シート1、シート2相互が書き換え可能の同期化です。 ・A1とD4、B3とE6、のように互いに照合箇所のセル同士を同期反映させたいと考えております。 なお、他の質問を参照したところ、 シート1のA1とシート2のD4の単一セルを同期かする方法は確認できました。(以下参照) ***************************************************************** シート1のコードは Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then Worksheets("シート2").Range("D4") = Target End If End Sub シート2のコードは Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$D$4" Then Worksheets("シート1").Range("A1") = Target End If End Sub *************************************************************** これを参考にVBAの シート1のコードエディターに Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$2" Then Worksheets("シート2").Range("D5") = Target End If End Sub シート2のコードエディターに Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$D$5" Then Worksheets("シート2").Range("A2") = Target End If End Sub というように追記していったのですが、エラーとなってしまいます。 お詳しい方がおられましたらお願いいたします。

  • エクセルVBAについて

    http://okwave.jp/qa/q7236213.html 上記質問の発展形なのですが 同様のことを E列に日付 F列に売上 G列に結果 でやりたいのですが この時A列~C列のマクロも残したままでしたいのですが 下記のように同様のプロシージャーを下段に書けばできると思ったのですが うまくいきません。 Private Sub worksheet_change(ByVal Target As Excel.Range) If Target.Address <> "$A$1" Then Exit Sub If Target = "" Then Exit Sub Range("C10:C65536").ClearContents With Range(Cells(9 + Range("A1").Value, "C"), Cells(Range("A65536").End(xlUp).Row, "C")) .FormulaR1C1 = "=MAX(RC2:R[" & -Range("A1").Value + 1 & "]C2,FALSE)" .Value = .Value End With End Sub Private Sub worksheet_change(ByVal Target As Excel.Range) If Target.Address <> "$E$1" Then Exit Sub If Target = "" Then Exit Sub Range("G10:G65536").ClearContents With Range(Cells(9 + Range("E1").Value, "G"), Cells(Range("E65536").End(xlUp).Row, "G")) .FormulaR1C1 = "=MAX(RC6:R[" & -Range("A1").Value + 1 & "]C6,FALSE)" .Value = .Value End With End Sub どなたかお知恵を拝借できませんでしょうか?

  • エクセルVBAの記述法(Worksheet_Changeで)

    入力があればセルが黄色のなり、入力がなければ無色とするマクロです。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Value <> "" Then Target.Interior.ColorIndex = 6 Else Target.Interior.ColorIndex = xlNone End If End Sub このように書くと、通常は正しく動きますが、ドラッグした場合や、複数セルを一度にクリアした場合、エラーになってしまいます。 ただしく作動させるにはどう直せばいいのでしょうか?

  • データ更新時の処理について(エクセルVBA)

    セルA2に数字の66が入っているとして、セルA2を67に更新した瞬間に67-66という処理をさせたいのですが、下記の???の部分が分かりません。どなたか、教えてください。お願いします。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$2" Then  ??? End If End Sub

  • エクセルのVBAについて教えてください。

    エクセルのVBAについて教えてください。 下記のような構文で、Dの行にAやBの文字が入力された時、その都度 セルの色が変わるようにはできたのですが、本当は、「C5」セルに文字が 入力された時、「C5」だけでなく「B5:J5」の範囲でセルの色を変えたい のですが、どうすれば良いのでしょうか。 ご存知の方是非教えてください。 Private Sub Worksheet_Change(ByVal Target As Range) Dim myColor As Integer If Target.Count > 1 Then Exit Sub If Target.Column <>4 Then Exit Sub Select Case Target.Value Case "A" myColor = 34 '水色 Case "B" myColor = 40 '肌色 Case Else myColor = xlNone End Select Target.Interior.ColorIndex = myColor End Sub

専門家に質問してみよう