• ベストアンサー

Excelのプロシジャーで有効範囲のセルを限定したい

Excelの「コードの表示(V)」に、下記のフォントサイズ変更コードを登録してあります。この有効範囲を、あるセル範囲、たとえば（C3:S20) などのように限定したいのですが、どう記述したらよいのでしょうか、教えて下さい。よろしくお願いします。 （現在のコード） Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range Application.EnableEvents = False For Each c In Target If IsNumeric(c.Value) Then If Len(Mid$(c.Text, InStr(c.Text, ".") + 1)) > 1 Then c.Font.Size = 8 Else c.Font.Size = 9 End If End If Next c Application.EnableEvents = True End Sub

  • awazo
  • お礼率97% (616/629)

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

  • ベストアンサー
  • zap35
  • ベストアンサー率44% (1383/3079)
回答No.3

＃０２さま。ご指摘ありがとうございました。おっしゃるとおりです。 ＞If Len(Mid$(c.Text, InStr(c.Text, ".") + 1)) > 1 Then この条件は 　・小数点がある場合は、小数点部の桁数が２桁以上 　・小数点がない場合は数値の桁数が２桁以上 になっています。その仕様で正しいですか？ 単純に「小数あり→８ポ」「小数なし→９ポ」で良いなら 　If (c.Value * 10 Mod 10) > 0 Then のように剰余を利用する手もあると思います。でも希望する仕様がはっきりしないのでこれで十分か分かりませんが…

awazo
質問者

お礼

zap35さん　ありがとうございました。 小数桁数にこだわらないことにし、小数つきか整数かの判別のみで、下記で落ち着きました。 Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range, r as range set r = Application.Intersect(Me.Range("C3:G20"),Target) if r is nothing then exit sub Application.EnableEvents = False For Each c In r If IsNumeric(c.Value) Then If Int(c.Value) <> c.Value Then c.Font.Size = 8 Else c.Font.Size = 9 　　 End If End If Next c Application.EnableEvents = True End Sub

その他の回答 (2)

  • ja7awu
  • ベストアンサー率62% (292/464)
回答No.2

zap35さん提示のコードですと 　Application.EnableEvents = False になっているままで　Exit Sub　になる場合がありますので、具合悪いと思いますよ。 　Set trg = Intersect(Target, Range("C3:S20")) 　If trg Is Nothing Then Exit Sub 　Application.EnableEvents = False　'　<--- ここに移す 　For Each c In trg '修正 これで如何ですか。

awazo
質問者

お礼

ja7awuさん　ありがとうございました。 とりあえず動きましたので、ゆっくり勉強させていただきます。

  • zap35
  • ベストアンサー率44% (1383/3079)
回答No.1

例えばこんな感じでしょうか Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range Dim trg As Range '追加 　Application.EnableEvents = False 　Set trg = Intersect(Target, Range("C3:S20")) '追加 　If trg Is Nothing Then Exit Sub '追加 　For Each c In trg '修正 　　If IsNumeric(c.Value) Then 　　　If Len(Mid$(c.Text, InStr(c.Text, ".") + 1)) > 1 Then 　　　　c.Font.Size = 8 　　　Else 　　　　c.Font.Size = 9 　　　End If 　　End If 　Next c 　Application.EnableEvents = True End Sub

awazo
質問者

お礼

zap35さん　いろいろありがとうございました。

awazo
質問者

補足

zap35さん　ありがとうございます。 どういうわけか、少数ありの場合フォントサイズ 8 、整数の場合 9 というふうに反応してくれません。お助けください。よろしくお願いします。

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • Excelで入力数値の桁数に応じてフォントサイズを変える方法

    ＶＢＡの初心者です。 Excelで列幅＝３の、列数の多い表を作りました。 ある程度見やすいフォントサイズ９ｐにすると、桁数の多い数値が####となってしまいます。 その場合には、８ｐに変えて４桁まで見られるようにしたいのです。 そこで、下記のプロシージャを組み込んでみました。 Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range, r As Range Set r = Application.Intersect(Me.Range("B2:BJ10"), Target) If r Is Nothing Then Exit Sub Application.EnableEvents = False For Each c In r If IsNumeric(c.Value) Then If LenB(c.Value) > 5 Then c.Font.Size = 8 Else c.Font.Size = 9 End If End If Next c Application.EnableEvents = True End Sub ところが、実際に数値を入れてみると、どういうわけか 1.2 など３バイトの数値も８ｐになってしまいます。 LenB(1.2)=3 であるのに、どういう現象なのかわかりません。 いきなり If LenB(c.Value) > 5 Then　としたのが間違っているのかと思うのですが、どう直したらよいか教えて下さい。よろしくお願いします。

  • ExcelのVBで、Rangeの範囲に任意のセル値を使うには

    VB初心者で行き詰っております。 前任者の作成したVBコードで、特定のセルの入力をテンキーで入力できるようにしています。 VBのコードについては、下記の通りとなっております。 Private Sub Worksheet_Change(ByVal Target As Range) Dim crng As Range Dim ttarget As Range Application.EnableEvents = False Set ttarget = Application.Intersect(Target, Range("C6:AG35")) If Not ttarget Is Nothing Then ttarget = Application.VLookup(ttarget, Worksheets("入力").Range("A1:B10"), 2,False) For Each crng In ttarget If IsError(crng) Then crng.Value = "" End If Next End If Application.EnableEvents = True End Sub ここで、シート内の範囲が変更となる（対象となる行が増減される）ことが発生します。 Set ttarget = Application.Intersect(Target, Range("C6:AG35")) ※この部分がRange("C6:AG37")や、Range("C6:AG33")などに変更となるということです。 その都度、VBの変更をかけると可能なのですが、より効率的にするため、入力という名前のシートに ある空きセルをうまく活用したいと考えております。 Range("C6:AG35")の部分で、任意のセルを参照する変数を利用するには、 どのように記述したらよろしいでしょうか？ また、別法として、常に行数をカウントできる方法でも可能なのかもしれません。 最初の行に値するセルがC6から始まり、最終行よりも下は空白セルとなります。 とすれば、行数をカウントして変数に組み込むことも一つなのかもしれませんが、技術がないため、 思いつくだけにとどまっております。 アドバイスをいただければと思います。よろしくお願いします。

  • エクセル　マクロ　初心者です

    エクセルマクロ初心者です。 以下の２つの Private Sub Worksheet_Change(ByVal Target As Range)を１つのシートで実行させたいのですが、 当方、初心者なので組み合わせ方が分かりません。 よろしくお願いします。 ===No1=== Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Target = StrConv(Target, vbUpperCase) Application.EnableEvents = True End Sub ===No2=== Private Sub Worksheet_Change(ByVal Target As Range) Dim Ans As Integer If Target.Count = 1 Then Ans = MsgBox("コピーは禁止!!", vbCritical) MsgBox "データを消去します。" With Application .EnableEvents = False .Undo .EnableEvents = True End With End If If Target.Count = 1 Then Exit Sub Else MsgBox “複数セルのコピー禁止！" With Application .EnableEvents = False .Undo .EnableEvents = True End With End If End Sub ------------ 上記の２つを１つのシートで動作させたいのですが、うまくいきません。 単体では、動作します。

  • 空白状態でEnterを押したら指定のセルに飛びたい

    例えばF5セルで何も入力せずEnterを押したらC9に入力セルを飛ばしたくて 自分の力で調べた限りでは下のコードで可能なのですが Private Sub Worksheet_SelectionChange(ByVal Target As Range) With Range("F5,C9") If Not Intersect(Target(1), .Cells) Is Nothing Then Application.EnableEvents = False .Select Target(1).Activate Application.EnableEvents = True End If End With End Sub 上記コードはF5セルを選ぶと、次に飛ぼうとするC9セルが見えてしまいます。 これが見えずにできる他の方法があるか色々調べても見つかりませんでした； 何か可能な策はありますでしょうか・・？

  • excel 2007 VBA コードの記述

    Excel 2007 を使用しています。 TEST.xlsm というブック内に テスト01 というシートを作成し、そのタブを右クリックして コードの表示 を選択。 表示されたVBAコード入力シートに下記のコードを記述して使用してます。 Private Sub Worksheet_Change(ByVal Target As Range) 'この行から If Intersect(Target, Range("E3:E33,G3:G33,AH3:AH33,AJ3:AJ33,BK3:BK33,BM3:BM33")) Is Nothing Or Selection.Count <> 1 Then Exit Sub Application.EnableEvents = False If Target <> "" Then If IsNumeric(Target) Then Target = Target - 23 End If End If Application.EnableEvents = True End Sub 'この行まで この条件に新たに下記のコードを追加したいと思い ネット検索しながらあれこれ試行錯誤してますが まだまだVBA初心者のため上手く機能してくれません。 ※上のコードだけなら思った通りに機能します。 Private Sub Worksheet_Change(ByVal Target As Range) 'この行から If Intersect(Target, Range("Y3:Y33,BB3:BB33,CE3:CE33")) Is Nothing Or Selection.Count <> 1 Then Exit Sub Application.EnableEvents = False If Target <> "" Then If IsNumeric(Target) Then Target = Target - 30 End If End If Application.EnableEvents = True End Sub 'この行まで どなたかこれら二種のコードを一つにまとめた記述方法を 教えて頂けますでしょうか？

  • 指定範囲のセルが変更されたら

    　下記のコードで1つのセル(A1)が変更されたら入力前の元データを別シート(A1)に保存できるようにしたのですが、指定範囲(I10:CW42,2行3列を一升)のセルが変更されたら別シートの指定範囲(I10:CW42)に保存できるようにしたいのですが方法がありましたらお教え下さい。お願いします。 Windows7・SP1 Office2010 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$A$1" Then Exit Sub Application.EnableEvents = False Application.Undo Sheets("Sheet2").Range("A1").Value = Range("A1").Value Application.Undo Application.EnableEvents = True End Sub

  • WorkSheet_Changeを2つ反映させる

    　下記のコードをWorkSheetで2つ反映させるにはどうしたらいいでしょうか？どちらか一つなら反映するのはわかりますが、どう名前を変更すればいいのかお教え願えませんでしょうか？ windows7・SP1 Office2010 Private Sub WorkSheet_Change(ByVal Target As Range) If Intersect(Target, Range("C1")) Is Nothing Then Exit Sub '検査範囲 Application.EnableEvents = False '再帰実行の停止 If Range("C1").Value <> Sheets("祝祭日").Range("A1").Value Then MsgBox ("祝日の設定を反映するため年度を同じにしてください。") End If Application.EnableEvents = True End Sub Private Sub WorkSheet_Change(ByVal Target As Range) Dim MyRow As Long Dim MyCol As Integer MyRow = Target.Row MyCol = Target.Column With Worksheets("メイン・1").Select If MyRow = 1 And MyCol = 7 Then If Target = 4 Then 'または　If Target = 1 Then メインデータの復元 '動かしたいマクロ名 End If End If End With End Sub

  • エクセル　ＶＢＡマクロ if文　はどうすれば？

    先ほど質問したのですが、さらにわからなくなったのでお願いします 先ほどの質問 ～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～ http://okwave.jp/qa/q7236338.html >変数と式の両立は難しいでしょうからどうすればよいのでしょう？ 　⇒関数では出来無いのはエクセルの常識ですのでマクロ（ＶＢＡ）組込みになります。 一例です。 対象シートタブ上で右クリック→コードの表示→以下のコード貼り付けてA1に枚数を入力して お試しください。 サンプルコード Private Sub Worksheet_Change(ByVal Target As Range) 単価 = 5 If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub If IsNumeric(Target.Value) And Target.Value > 0 Then 　Application.EnableEvents = False 　Target.Value = Target.Value * 単価 　Application.EnableEvents = True End If End Sub ～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～ ↓変更＆応用したのですが、、、、 ＥＸ：（セル）　　 　セル番号　　用紙種類１～３　　　　　　　用紙種類 　　　C12　　　Ａ３モノクロ１　　　　　D12　　Ａ３カラー１ 　　　C13　　　Ａ３モノクロ２　　　　　D13　　Ａ３カラー２ 　　　C14　　　Ａ３モノクロ３　　　　　D14　　Ａ３カラー３ ※金額の違いは、モノクロとカラーの値段が違うだけ 　１～３は金額的な違いはない とあった場合、 ためしに先ほどのを応用して用いたのですが 変更点は、用紙サイズ、カラーの有無による金額 　　　　　　　出力先セルの番号 Private Sub Worksheet_Change(ByVal Target As Range) を Private Sub A4_mono_1(ByVal Target As Range) Private Sub A4_mono_2(ByVal Target As Range) ・　 　　　　　　　　　　　・ 　　　　　　　　　　　・ と変更したのですがうまく動作しなかったのですが、 どういった点が悪かったのでしょうか？ ～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～ 最終的な質問↓ 上記のものはＶＢＡマクロ文は基本１つのみなので、if文で作らなくてはいけないということが分かったのですが、そこでさらに疑問が浮かびました、 Private Sub Worksheet_Change(ByVal Target As Range) If or(target.columns = C12:C14) Then 単価1 = 7.6 If Intersect(Target, Range("C12:C14")) Is Nothing Then Exit Sub If IsNumeric(Target.Value) And Target.Value > 0 Then Application.EnableEvents = False Target.Value = Target.Value * 単価1 Application.EnableEvents = True単価1 = 7.6 elseif or(target.columns = D12:D14) Then 単価2 = 30.6 If Intersect(Target, Range("D12:D14")) Is Nothing Then Exit Sub If IsNumeric(Target.Value) And Target.Value > 0 Then Application.EnableEvents = False Target.Value = Target.Value * 単価2 Application.EnableEvents = True End If End Sub としたっ場合全く式になっていません どのようにすればよいのでしょう？

  • エクセル　加算　

    １つのセルに数字を入力すると加算されているマクロを探していたら 以下の回答がありました Dim memo Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$A$1" Then Exit Sub If Target.Value <> "**" And IsNumeric(Target.Value) = False Then Exit Sub Application.EnableEvents = False If Target.Value = "**" Then memo = 0 Else memo = memo + Target.Value End If Target.Value = memo Application.EnableEvents = True End Sub このマクロですがＡ１に入力した場合に適用しますが、このマクロをたとえばＡ１からＣ１の範囲で使用した１場合にどのようなマクロをすればよいかわかりません それか、このマクロではそのようなことができるのかもわかりませんので教えて頂けないでしょうか

  • エクセルVBAで重複入力の排除

    すでに入力規則はリストで使用しております。 そのためVBAで重複入力の排除を行おうと思います。 一応以下のコードでできたのですが、もっと良い方法があったら教えてください。 お願いいたします。 Private Sub Worksheet_Change(ByVal Target As Range) 　　 Dim myDic As Object 　　 Dim c As Variant, varData As Variant 　　 Dim i As Long 　　 If Application.Intersect(Target, Range("A1:A50")) Is Nothing Then Exit Sub 　　 Set myDic = CreateObject("Scripting.Dictionary") 　　 varData = Range("A1:A50").Value 　　 For Each c In varData 　　　　 If Not c = Empty Then 　　　　　　 i = i + 1 　　　　　　 If Not myDic.Exists(c) Then 　　　　　　　　 myDic.Add c, Null 　　　　　　 End If 　　　　 End If 　　 Next 　　 If myDic.Count < i Then 　　　　MsgBox Target & " は重複！" 　　　　Application.EnableEvents = False 　　　　Application.Undo 　　　　Application.EnableEvents = True 　　 End If End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する