• ベストアンサー

エクセル2013

下記のコードがうまくいかないのですが間違っているところ教えてください。 標準モジュールです。 Sub color_change() ActiveSheet.Range("b1").Select If ActiveSheet.Range("B1") = "B" Then Selection.Font.ColorIndex = 3 End If End Sub

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

  • ベストアンサー
  • kkkkkm
  • ベストアンサー率65% (1619/2458)
回答No.1

ActiveSheetのB1の値がBだと文字の色が赤になる という動作をしますが、何がうまくいかないのでしょう?

kumashake
質問者

お礼

ご回答ありがとうございます。 その動作をしてくれないので困ってたのですが、ACTIVESHEET.UNPEOTECTが必要だったみたいです。 書式設定でロックしてないセルなので、まさか、それが必要とは思わなかった次第。

関連するQ&A

  • エクセルのVBAを教えて下さい。

    Private Sub OptionButton1_Click() Range("A15").Select Selection.Font.ColorIndex = 1 Range("B12").Select Selection.Font.ColorIndex = 1 Range("A18").Select Selection.Font.ColorIndex = 2 Range("B18").Select Selection.Font.ColorIndex = 2 Sheets("シート1").Image1.Visible = False Sheets("シート1").Image2.Visible = True End Sub 上記のようなプログラムがありますが、たとえば、以下をまとめてコンパクトに出来ますか? Range("A15").Select Selection.Font.ColorIndex = 1 Range("B12").Select Selection.Font.ColorIndex = 1 オートシェイプを利用して画像をエクセル内に作りました。 その画像を表示、非表示させたいのですが、どのようにすればよいでしょうか?よろしくお願いします。

  • エクセルのマクロ

    セルの値が変わったら動くマクロですが、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

  • エクセルで繰り返し処理をしたいのですが

    下記のマクロを6行目で展開しています。 これと同じ処理を7行目~36行目めまでさせたいのですが どうやればいいのか教えていただけないでしょうか? sub test() Select Case a Case 2, 3, 4, 5, 6 Range("F6").Select Selection.FormulaR1C1 = _ "=IF(RC[-1]-RC[-2]-0.75-RC[8]-RC[9]<=0,0,RC[-1]-RC[-2]-0.75-RC[8]-RC[9])" Range("H6").Select Selection.FormulaR1C1 = "=IF(-7.75>=RC[9],0,RC[9])" Range("J6").Select Selection.FormulaR1C1 = _ "=IF(IF(RC[-5]<=22,0,(RC[-5]-22-RC[6]))<=0,0,IF(RC[-5]<=22,0,(RC[-5]-22-RC[6])))" Range("B6:W6").Select With Selection.Interior .ColorIndex = 2 .Pattern = xlSolid End With Case 0, 1 Range("F6").Select Selection.ClearContents Range("H6").Select Selection.ClearContents Selection.FormulaR1C1 = "=IF(RC[-5]<=22,0,(RC[-5]-22-RC[6]))" Range("J6").Select Selection.ClearContents Range("B6:W6").Select With Selection.Interior .ColorIndex = 45 .Pattern = xlSolid End With End select End sub

  • マクロの簡素化

    下記マクロです。 Range("AE6:AE1005").Select Selection.ClearContents Selection.Interior.ColorIndex = xlNone If Range("AD6").Value > 5 Then Range("AE6") = "*" Range("AE6").Select With Selection.Interior .ColorIndex = 3 End With Else End If If Range("AD7").Value > 5 Then Range("AE7") = "*" Range("AE7").Select With Selection.Interior .ColorIndex = 3 End With Else End If If Range("AD8").Value > 5 Then Range("AE8") = "*" Range("AE8").Select With Selection.Interior .ColorIndex = 3 End With Else End If 中略(セルを一個づつ指定しています) If Range("AD1004").Value > 5 Then Range("AE1004") = "*" Range("AE1004").Select With Selection.Interior .ColorIndex = 3 End With End If If Range("AD1005").Value > 5 Then Range("AE1005") = "*" Range("AE1005").Select With Selection.Interior .ColorIndex = 3 End With Else End If Range("AE3").Select 有るセルを参照しその値が5以上だったら別のセルに*マークとセルに色を付けるマクロですが、一個づつセル指定をしていますが、何とか短く出来ないでしょうか? お分かりになる方宜しくお願い致します。

  • Excelマクロでオートフィルターからコピペ

    ファイルのB列の値から0以外の値をオートフィルターで抽出し、値を、別のファイルのD列の一番下に貼りつけるマクロを作っていますがうまくいきません。 今作ったのは Sub macro1() If ActiveSheet.AutoFilterMode = False Then Range("A:G").Select Selection.AutoFilter Else Selection.AutoFilter Range("A:G").Select Selection.AutoFilter End If Selection.AutoFilter Field:=2, Criteria1:="<>0", Operator:=xlAnd Range("A1").Select Range("B2", Range("B2").End(xlDown)).Select Selection.Copy Windows("貼りつけるファイル名").Activate Cells(Rows.Count, 4).End(xlUp).Offset(1).Select ActiveSheet.Paste End Sub です。 フィルターで0以外の値を抽出しコピーまではできていますが、貼りつけるところでエラーがでます。 Microsoft Visual Basic 400 というエラーです。 何が悪いのか分かりません・・・。 分かる方いましたらご教授ください。よろしくお願いします。

  • エクセルのマクロ

    Sub test() Dim x As Range  For Each x In Selection    If x.Value <> "●" And Selection.Font.ColorIndex = 0 Then    x.Value = "○"  End If Next End Sub 上記は、選択されているセルのフォントが黒でかつ"●"が入力されていない場合は"○"を入力する、というマクロですがうまく動作しません。どうすれば正常に動作するようになるでしょうか?

  • excel マクロ Selection.Formula

    VBA初心者です。 excelの表に文字を記入して、それをカード化したいと思ってます。 テキストボックスをN回コピーして、それぞれに名前をつけて、またそれぞれにテキストが入力されたセルへ参照先を指定したいのですが、上手くいきません。 Dim n As Integer 'カードのコピー回数はD4のセルを参照 n = Range("input!D4").Value If n >= 1 Then ActiveSheet.Shapes("card0").Select Selection.Copy ActiveSheet.Paste Selection.Name = "card1" Selection.Formula = "=formula!B6" End If If n >= 2 Then ActiveSheet.Shapes("card0").Select Selection.Copy ActiveSheet.Paste Selection.Name = "card2" Selection.Formula = "=formula!B7" End If If n >= 3 Then ActiveSheet.Shapes("card0").Select Selection.Copy ActiveSheet.Paste Selection.Name = "card3" Selection.Formula = "=formula!B8" End If If n >= 4 Then ActiveSheet.Shapes("card0").Select Selection.Copy ActiveSheet.Paste Selection.Name = "card4" Selection.Formula = "=formula!B9" と延々と50回繰り返してます。 希望は150~200回繰り返したいのですが、 マクロ記録などや他の回答などを参考にしながら、 初心者なりに考えて、 Sub cardproductionA4() 'カードのコピー回数を指定 N=総回数 P=1~N回 Dim N As Integer, P As Integer N = Range("input!D4").Value 'カードのコピー For P = 1 To N If N >= P Then ActiveSheet.Shapes("card0").Select Selection.Copy ActiveSheet.Paste Selection.Name = "card" & CStr(P) Selection.Formula = "=formula!B(P+5)" End If Next P End Sub としました。 でも、参照先が漸次変わっていって欲しいのですが、 Selection.Formula の先がエラーで出来ません。 どのように記述すれば宜しいのでしょうか? あるいは、そもそもVBAを理解していないので、間違っているのかもしれませんが、 御教授お願い致します。

  • エクセルVBAについて

    エクセルVBA初心者で、勉強中の者です。 添付画像のような時間のグラフのようなものを作りたいと思っています。 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Sub 時間グラフ作成() If Worksheets("(1)(1)(1)(1)(1)").Range("F2").Value = CDate("9:05") Then Worksheets("(2)(2)(2)(2)").Range("I2").Select  With Selection.Interior   .ColorIndex = 8   .Pattern = xlSolid  End With Elseif Worksheets("(1)(1)(1)(1)(1)").Range("F2").Value = CDate("9:10") Then Worksheets("(2)(2)(2)(2)").Range("J2").Select  With Selection.Interior   .ColorIndex = 8   .Pattern = xlSolid  End With  ・  ・   ・ End If End Sub 'それから、終了の時間を入れて、開始から終了までの間を塗りつぶす。 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 以上のように作成しようと考えていましたが、いざやろうとすると 1行に対してあまりにも膨大な記述をしなくてはならないことに 気がつきました(一月分ともなると恐ろしいです・・・)・・・。 もっと効率的な方法はあるものでしょうか? よろしくお願いいたします。

  • 型が一致しない というエラー

    Private Sub Worksheet_Change(ByVal Target As Range) If Target = Range("B1") Then Range("B3:B8").Select Selection.ClearContents End If End Sub というコードを書いています。 B3~B8は「数字」という書式です。 型が一致しない13番のエラーが出ます。 原因と対処法を教えてください。 宜しくお願いします。

  • Excel VBAについて

    Excelで、指定したセル範囲の外枠に罫線を引き四角形を作り、B1の数字を変えていくと四角形を横に描いていくというマクロを作成したのですが、B1の数値を変えてマクロを実行すると以前に描いた四角形が残ってしまいます。これを数値を変えてマクロを実行すると、以前の四角形を消して新たに四角形を描くにはどうすればよいのでしょうか。何かいい方法があれば教えてください。宜しくお願いします。以下にコードを示しておきます。 Public Sub Main_Code() a = ThisWorkbook.Worksheets("Sheet1").Range("B1") If a = 2 Then Range("I26:K35").Select Selection.BorderAround Weight:=xlMedium Range("B1").Select ElseIf a > 2 Then Dim i As Integer For i = 3 To a Range("I26:K35").Select Selection.BorderAround Weight:=xlMedium Range("I26:K35").Select Selection.Copy Cells(26, 3 * i + 3).Select ActiveSheet.Paste Application.CutCopyMode = False Range("B1").Select  Next i  End If End Sub

専門家に質問してみよう