• ベストアンサー

Excelで条件にあったセルを検索して、行全体に色をつける方法

こんにちは 初歩的な質問で大変恐縮なのですが、助けていただけませんでしょうか。 エクセルのシート上のG列4～120行に入っている数値を検索して、その値が条件を満たす場合にその行全体に色をつけたいと思い、以下のようなコードを書いてみたのですが、「型が一致しません」というエラーがでてしまいます。(色は一応つくのですが・・・) Sub TestMacro() 　Dim i As Integer 　　For i = 4 To 120 　　If Sheets("aaa").Cells(i, "G").Value < 365 Then 　　　Sheets("aaa").Rows(i).Select 　　Selection.Interior.ColorIndex = 7 　End If Next i End Sub この原因は何なのでしょうか？教えてください。 宜しくお願いします。

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

  • ベストアンサー
  • BLUEPIXY
  • ベストアンサー率50% (3003/5914)
回答No.1

Sheets("aaa").Cells(i, "G").Value の値で数値でないモノが含まれているのではないでしょうか

mamakki
質問者

お礼

BLUEPIXYさん まさに「#VALUE!」が入っているセルがありました・・・。 とりあえずISERRORでエラー表示を出ないようにして 解決しました。 どうもありがとうございました！！

その他の回答 (2)

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.3

本当に >にその行｛全体」！！に色をつけたいと 言うなら（私は個人的に、しつこいと思いますが） シート名をSheet1に変えてます。 EntireRow.の問題と思います。 Sub TestMacro() Dim i As Integer For i = 4 To 120 If Sheets("Sheet1").Cells(i, "G").Value < 365 And Cells(i, "G") <> "" Then Sheets("Sheet1").Rows(i).EntireRow.Interior.ColorIndex = 7 End If Next i End Sub でうまくいきました。 VBAでなくても、条件付書式でもできる要求ですね。

mamakki
質問者

お礼

ありがとうございます。 条件付書式だと行数が多くて可変の可能性があったので、マクロで実行したいと思っていました。 ご丁寧にありがとうございました。

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

mamakkiさん、こんにちは。 それは、G列の該当部分に、エラー値が入っていると思いますね。他は、今は思いつきません。 Not IsError(....) や、VarType(....) = vbDouble などで、条件排除をしてみたらいかがですか？

mamakki
質問者

お礼

まさにその通りでした。 お恥ずかしい限りです。 マクロでの条件排除も試して見ます。 ありがとうございました。

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

関連するQ&A

  • 色のないセルの行削除

    任意の色で塗りつぶされたセルがあって、塗りつぶされたセルが存在する行を削除するマクロ。 Sub 行削除() Dim r As Integer Dim c As Integer For c = ActiveSheet.UsedRange.Columns.Count To 1 Step -1 　　For r = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 　　　　If Cells(r, c).Interior.ColorIndex <> xlNone Then 　　　　　　　Rows(r).Delete 　　　　End If 　　Next Next End Sub この逆のことがしたいのですが、わかりません。 ちなみにこのプログラムはそのままＣ＆Ｐです。 内容もあまり理解できていません。(^_^;) 添付画像の逆に色のついた行だけ残したいです。 よろしくお願いします

  • エクセル マクロ　複数セルの色付けについて

    マクロ初心者で苦戦しており、教えていただけると大変ありがたいです。 エクセルの複数のシートに、問2_1　、問2_2　、問2_10 （全部で問は2_28まであります）等の文字列があり、その文字に合わせて、そのセルだけ色を付けたいと考えております。 今書いているコードだと、ワークシートのA列にある場合は色が付けられるのですが、それ以外に色が付けられません。どこが間違っているでしょうか？ どうぞご指導お願いいたします。 Sub 色つけ() Dim Maxrow As Long Dim i As Long Maxrow = Cells(Rows.Count, i).End(xlUp).Row For i = 1 To Maxrow If InStr(Cells(i, 1), "2_1 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 6 If InStr(Cells(i, 1), "2_2 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 6 If InStr(Cells(i, 1), "2_23 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 23 If InStr(Cells(i, 1), "2_13 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 4 If InStr(Cells(i, 1), "2_6 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 7 Next i End Sub

  • セルの色を変えたいのですが。

    セルの色を変えたいと思っています。 現状はマクロで Sub カラー1() i = 7 For j = 21 To 100 RESULT = Cells(j, i) If RESULT = "#N/A" Then Cells(j, i).Interior.ColorIndex = 3 End If Next j i = 17 For j = 21 To 100 RESULT = Cells(j, i) If RESULT = "#N/A" Then Cells(j, i).Interior.ColorIndex = 3 End If Next j End Sub とかいてあります。 "#N/A"ですがVLOOKUP関数で値が一致していない場合に でてくるのですが、この時にセルの色を変えて表示したいと思っています。 どうすればよいでしょうか、教えてください。

  • セルの選択でその行に色を付けたい

    横に長いデータがあり、その1つのセルを選択するとその行全体に色が付くようにしたいのです。過去の質問で以下のようなものを見つけましたが、問題はその場合、通常のコピー→貼り付けができない点です。 その辺を問題なく行える方法はないでしょうか？ よろしくお願いいたします。 Public m, n Private Sub Worksheet_SelectionChange(ByVal Target As Range) If m <> 0 Then Range(Cells(m, 1), Cells(m, 256)).Interior.ColorIndex = n End If m = Target.Row n = Target.Interior.ColorIndex Range(Cells(Target.Row, 1), Cells(Target.Row, 256)).Interior.ColorIndex = 6 End Sub

  • 全体を表示　マクロ　色が思うように、表示できない

    　「マクロ　色が思うように、表示できない」で質問したことへの追加になります。「S1299792さん」から、全体を表示しないと回答がしずらいことの指摘がありました。すみませんでした。その通りだと思いましたので、再度質問させて頂きました。　また、「watabe007さん」からの回答からコピー貼り付けの部分を教えて頂いたものも使って、改めてコードを書き換えて示します。 　現在コピー貼り付け・ソート・J;列以外はコード通りに出来上がっています。それにJ列の欠・合も指示通りにできています。不だけがピンク色になりません。 なお、なぜか一カ所だけピンクになっているところがあります。条件の「条件　合計」・「条件　不合格」最初のEの不のところの条件だけは、ピンクになっています。 　下記のが全体のコードです。 Sub 条件つきソート色つけ() Dim LastRow As Long, i As Long 　　Application.ScreenUpdating = False 　　Application.Calculation = xlCalculationManual 　　With Sheets("sheet1") 　　　　LastRow = .Cells(Rows.Count, "A").End(xlUp).Row 　　　　.Range("A1:J" & LastRow).Copy Sheets("sheet2").Range("A1") 　　End With 　　Application.CutCopyMode = False 　　Sheets("Sheet2").Select 　　Range("A1:J" & LastRow).Sort Key1:=Range("H1"), _ 　　　　Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _ 　　　　MatchCase:=False, Orientation:=xlTopToBottom, _ 　　　　SortMethod:=xlPinYin, DataOption1:=xlSortNormal 　　Range("E2:J" & LastRow).Interior.ColorIndex = 0 '文言の詳細について '部品名と詳細---------------------------------------略称　　　　　　　　　　　 'ghyu--------------------------------------←E列　　 'klub---------------------------------------←F列　 'llpo----------------------------------------←G列　 '合計個数(合計)-------------------------←H列　 合計　　 '数量順位---------------------------------←I列 　 順位 '合格・不合格(合・不)欠品(欠)-----←J列　 合・不・欠 For i = 2 To LastRow If Cells(i, "E").Value = "" Then Cells(i, "E").Resize(, 6).Value = "欠" 'E列 ElseIf Application.CountIf(Cells(i, "E").Resize(, 6), "欠") > 0 Then Cells(i, "J").Value = "欠" ElseIf Cells(i, "H") >= 1 And Cells(i, "H") <= 49 Then '条件 合計 Cells(i, "J") = "不" ElseIf (Cells(i, "E") >= 20 And Cells(i, "F") >= 6) And Cells(i, "G") >= 10 Then '条件 これ以上は合格 Cells(i, "J") = "合" ElseIf (Cells(i, "E") = 0 Or Cells(i, "F") = 0) Or Cells(i, "G") = 0 Then '条件 全て０で不合格 Cells(i, "J") = "不" ElseIf (Cells(i, "E") <= 19) Then '条件　 不合格 Cells(i, "J") = "不" ElseIf (Cells(i, "F") <= 5) Then '条件　 不合格 Cells(i, "J") = "不" ElseIf (Cells(i, "F") <= 10) Then '条件 　不合格 Cells(i, "J") = "不" ElseIf (Cells(i, "E") >= 20 And Cells(i, "F") >= 6) And Cells(i, "G") <= 9 Then '条件 E=○　F=○　G=×　 不合格 Cells(i, "J") = "不" ElseIf (Cells(i, "E") >= 20 And Cells(i, "F") <= 5) And Cells(i, "G") <= 9 Then '条件 E=○　F=×　G=×　 不合格 Cells(i, "J") = "不" ElseIf (Cells(i, "E") <= 19 And Cells(i, "F") >= 6) And Cells(i, "G") <= 9 Then '条件 E=×　F=○　G=×　 不合格 Cells(i, "J") = "不" ElseIf (Cells(i, "E") <= 19 And Cells(i, "F") <= 5) And Cells(i, "G") >= 10 Then '条件　E=×　F=×　G=○　 不合格 Cells(i, "J") = "不" End If If Cells(i, "E") >= 1 And Cells(i, "E") < 20 Then Cells(i, "E").Interior.ColorIndex = 6 ' 6は　 黄色 End If If Cells(i, "F") >= 1 And Cells(i, "F") < 6 Then Cells(i, "F").Interior.ColorIndex = 6 ' 6は　　黄色　 End If If Cells(i, "F") >= 6 And Cells(i, "F") < 10 Then Cells(i, "F").Interior.ColorIndex = 34 '34は　 淡い青色 End If If Cells(i, "G") >= 1 And Cells(i, "G") < 10 Then Cells(i, "G").Interior.ColorIndex = 6 ' 6は　　黄色　 End If If Cells(i, "H") >= 1 And Cells(i, "H") <= 49 Then Cells(i, "H").Interior.ColorIndex = 4 ' 4は　 うぐいす色　 End If If Cells(i, "J") >= "不" Then Cells(i, "J").Interior.ColorIndex = 38 '38は ローズ 　　 If Cells(i, "J") >= "合" Then Cells(i, "J").Interior.ColorIndex = 2 ' 2は　 白色　 ElseIf Cells(i, "J") = "欠" Then Cells(i, "J").Interior.ColorIndex = 45 '45は　 薄いオレンジ色 End If For j = 5 To 9 'D-F If Cells(i, j).Value = 0 Then Cells(i, j).Interior.ColorIndex = 3 '3は　 　　赤色　 　　　　　 ElseIf Cells(i, j).Value = "欠" Then Cells(i, j).Interior.ColorIndex = 45 '45は　 薄いオレンジ色　　　　 End If Next j For k = 5 To 9 'G-I If Cells(i, j).Value = "欠" Then Cells(i, j).Interior.ColorIndex = 45 '45は　 薄いオレンジ色　　 End If Next k Next i Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub

  • セルの色によって条件文をつけることはできますか？２

    以前質問させていただいた内容なのですが、 質問用にフォーマットを作って質問させていただきました。 質問の通りであれば、問題なく解決できたのですが、 本物のデータで少し違うだけで動作ができません。 お力頂けますでしょうか。よろしくお願いします。 Excelでの質問です。vista利用。 セルの色によって条件文（IF)をつけることはできますか？ やりたいのは、下図で説明しますと、 A１５のセルに色付データが入ったらC15とE15のセルを掛け算し、 G１５のセルに表示。 A１６のように色無なら、Gは計算しない（表示しない）。 例 　　　　　A　　　　　　　　　　　　C　　　　　E　　　G １５　　色付セル　　　　　　　　３　　　　　２　　　６ １６　　白セル（色無し）　　　　５　　　　　４　　　 １７　　色付セル　　　　　　　　２　　　　　６　　　１２ A列には、別のデータシートからデータをコピーし貼り付けます。 全て数字が入っているのですが、数字は無視し、背景の色で判断します。 --------------------------------- 以前は下記のフォーマットで質問しました。 A１のセルに色付が入ったらB1とC1のセルを掛け算し、 D1のセルに表示。（Dセルにif文） A2のように色無なら、Dは計算しない（表示しない）。 例 　　　　　A　　　　　　　　　　　B　　　　　C　　　D １　　色付セル　　　　　　　　３　　　　　２　　　６ ２　　白セル（色無し）　　　　５　　　　　４　　　 ３　　色付セル　　　　　　　　２　　　　　６　　　１２ ここで、下記のVBAを教えていただきました。 Sub test() 'この行から Dim i As Long For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 1).Interior.ColorIndex <> xlNone Then Cells(i, 4) = Cells(i, 2) * Cells(i, 3) End If Next i End Sub　'この行まで --------------------------------- これならできたのですが、今回のようにセルの行が途中だとどこを修正すれば よいのか分かりません。 「１」の表示がある3か所をいじったのですがダメでした。 計算部分については Cells(i, 4) = Cells(i, 2) * Cells(i, 3) ↓↓↓ Cells(i, 7) = Cells(i, 3) * Cells(i, 5) 前回の質問URL http://oshiete1.watch.impress.co.jp/qa6855834.html よろしくお願いします。

  • Excelセル範囲内の値のみ1行づつ開ける

    下記コードでは1行づつ挿入により下段（罫線枠）までずれてしまいます。 範囲内（E8:G15）での値のみ1行づつ開け表-2のように罫線をずらさずにするにはどのようにすれば良いでしょうか。 どなたか解る方よろしくお願いします。 Sub Test() Dim i As Long If TypeName(Selection) <> "Range" Then Exit Sub With Selection For i = .Rows.Count To 2 Step -1 Intersect(.Cells(i, 1).EntireRow, .Columns).Insert xlDown Next End With End Su

  • エクセルで選択中の列や行を見やすくしたい

    タイトルのとおり、選択中の列や行の色が一列全部変るように したいと思い調べ、以下のＶＢＥコードを見つけたんですが Public m Private Sub Worksheet_SelectionChange(ByVal Target As Range) 　If m <> 0 Then 　　Range(Cells(m, 1), Cells(m, 256)).Interior.ColorIndex = xlNone 　End If 　Range(Cells(Target.Row, 1), Cells(Target.Row, 256)).Interior.ColorIndex = 6 　m = Target.Row End Sub 確かに色は変るんですが、もともとついている箇所の色が 消えていってしまいます。 色が消えずに同じことは出来ないでしょうか。 ご存知の方いらっしゃいましたら教えてください。 よろしくお願いします。

  • Do Loop Until 条件停止後のセル位置について

    こんにちは。いつもお世話になります。 ただ今、シート上の緑色のセルをカーソルで移動させるプログラムを 作っています。 停止の条件は[SHIFT]キーを押すと止まります。 一応は停止しますがセルの位置がズレてしまい、なんとか現在選択 している位置で停止できないものかと思い、アドバイス願います。 コードは下記になります。 Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vkey As Long) As Long Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Sub Key_Sample() Cells(1, 1).Select On Error Resume Next '繰返し開始 Do '上方向のキー入力判定 If GetAsyncKeyState(38) <> 0 Then Selection.Interior.ColorIndex = xlNone ActiveCell.Offset(-1, 0).Select Selection.Interior.ColorIndex = 4 Else Selection.Interior.ColorIndex = 4 End If '下方向のキー入力判定 If GetAsyncKeyState(40) <> 0 Then Selection.Interior.ColorIndex = xlNone ActiveCell.Offset(1, 0).Select Selection.Interior.ColorIndex = 4 Else Selection.Interior.ColorIndex = 4 End If '左方向のキー入力判定 If GetAsyncKeyState(37) <> 0 Then Selection.Interior.ColorIndex = xlNone ActiveCell.Offset(0, -1).Select Selection.Interior.ColorIndex = 4 Else Selection.Interior.ColorIndex = 4 End If '右方向のキー入力判定 If GetAsyncKeyState(39) <> 0 Then Selection.Interior.ColorIndex = xlNone ActiveCell.Offset(0, 1).Select Selection.Interior.ColorIndex = 4 Else Selection.Interior.ColorIndex = 4 ActiveCell.Select End If Sleep 100 Loop Until GetAsyncKeyState(16) <> 0 End Sub

  • 行に色を付ける

    本を片手にやっているのですが 分かっている人にしたらあほみたいなことなんでしょうがよろしくお願いします。 A列には日付B列には曜日（WEEKDAY関数で日曜が1）を入力してあります。土日の行ににピンクを塗りつぶしたいのですが Sub iro() Dim i As Integer, gyou As Long gyou = Range("b65536").End(xlUp).Row For i = 2 To gyou If Range("b65536").End(xlUp).Value = 1 Or 7 Then Rows(i).Interior.ColorIndex = 7 Else Exit For End If Next End Sub なんとなくここまでできたのですが、これだと 全部の行に色がついてしまいます。 何がいけないのでしょうか？ よろしくお願いします。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

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

質問する