• ベストアンサー

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

セルの色を変えたいと思っています。 現状はマクロで 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関数で値が一致していない場合に でてくるのですが、この時にセルの色を変えて表示したいと思っています。 どうすればよいでしょうか、教えてください。

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

  • ベストアンサー
  • papayuka
  • ベストアンサー率45% (1388/3066)
回答No.3

こんにちは。 VBAでは無いですが、VLOOKUP関数のあるセル(ここではA1)を選択して、条件付書式で「数式が」に =ISNA(A1) と入れて、パターンを指定して必要なセルにコピーすれば、目的は達せられると思います。($A$1にしないこと) 参考までに。

akashyati
質問者

お礼

ありがとうございます。 できました。

その他の回答 (2)

  • nishi6
  • ベストアンサー率67% (869/1280)
回答No.2

>#N/Aは文字列ではないということで判断してセルの色を変えるということはできないのでしょうか? 回答した、   If Application.IsNA(Cells(j, i)) Then がそれに該当しますが・・・ >エクセルはあまりよくわからないのでもう少し教えてください。 質問にある、  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 を見ると、変数宣言されていないので、 RESULT は Variant型変数です。(Variant型変数→なんでも格納できる変数型とでも言うか・・・) 従って、   RESULT = Cells(j, i)   If RESULT = "#N/A" Then は機能しています。しかし、Vlookupで返された答えの #N/A は文字列ではないので If RESULT = "#N/A" Then は セルに #N/A と入力しない限り成立しません。 従って、セルのパターンをColorIndex 3 にする塗つぶしは行われないことになります。 試しに、Vlookupで返された答えが #N/A のセルをA2として、=Type(A2) とすると16になります。 これはデータ型がエラー値ということです。文字列なら2になります。 再度回答を全て書くと(変数宣言をして、余分な変数'RESULT'は使っていません) Sub カラー1()   Dim i As Integer '列カウンタ   Dim j As Integer '行カウンタ   i = 7   For j = 21 To 100     'セルが #N/A ならセルを赤く塗る(ColorIndex = 3)     If Application.IsNA(Cells(j, i)) Then       Cells(j, i).Interior.ColorIndex = 3     End If   Next j   i = 17   For j = 21 To 100     If Application.IsNA(Cells(j, i)) Then       Cells(j, i).Interior.ColorIndex = 3     End If   Next j End Sub のようになります。 If Application.IsNA(Cells(j, i)) Then で、(Excel97はApplicationでOKのはずです) Cells(j, i)の内容が、エラー値『#N/A』かどうか調べています。 Application.IsNA(Cells(j, i)) はVBAの中でワークシート関数『ISNA()』を使っていて、 =ISNA(A2) のように使うと、セルA2が『#N/A』ならTrue が返ってきます。 これで、Cells(j, i)が『#N/A』なら If の判別式が True になって、次の行を実行するわけです。

akashyati
質問者

お礼

ありがとうございます。 只、うまくできませんでした。 G21からG100、Q21からQ100までVLOOKUP関数を使っています。 これは、M21からM100までに入力された値をみています。 入力されていない場合は#N/Aになるので、教えていただいたもので できると思ったのですができませんでした。 お時間があれば教えてください。

  • nishi6
  • ベストアンサー率67% (869/1280)
回答No.1

2箇所の RESULT = Cells(j, i) If RESULT = "#N/A" Then を If Application.IsNA(Cells(j, i)) Then にしてみて下さい。 『Option Explicit』を使って変数宣言を強制するようにしたほうが間違いを防止できます。 『#N/A』は文字列ではないため RESULT = "#N/A" で型の不一致が起きているはずです。 Excelのバージョンが分からないので、Application.IsNA にしています。 Excel2000 なら WorksheetFunction.IsNA の書き方が普通でしょうか。

akashyati
質問者

補足

Excelのバージョンは97です。 #N/Aは文字列ではないということで判断してセルの色を変えるということはできないのでしょうか? エクセルはあまりよくわからないのでもう少し教えてください。 宜しくお願いします。

関連するQ&A

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

    マクロ初心者で苦戦しており、教えていただけると大変ありがたいです。 エクセルの複数のシートに、問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 オニオン判定() Dim i As Integer, j As Integer, r As Integer Dim k As Double Range(Cells(17, 9), Cells(26, 14)).Interior.ColorIndex = 0 Range(Cells(30, 9), Cells(39, 14)).Interior.ColorIndex = 0 k = Cells(5, 2) 'B5セルの値 For j = 9 To 14 For i = 17 To 26 For r = 30 To 39 If Abs(Cells(i, j).Value - Cells(r, j).Value) <= 0.05 Then Cells(r, j).Interior.Color = vbYellow Cells(i, j).Interior.Color = vbYellow End If Next  Next   Next End Sub 対象のIf Abs(Cells(i, j).Value - Cells(r, j).Value) <= 0.05 Then で、それぞれ見比べて、0.05以上のずれがあるとセルが塗りつぶされないというマクロなのですが これを、If Abs(Cells(i, j).Value - Cells(r, j).Value) = 0 Thenという条件も追加して その時はセルを青に塗りつぶし、逆に0.05以上のずれがあるセルは赤に塗りつぶす。 みたいなマクロを書きたいです。 If Abs(Cells(i, j).Value - Cells(r, j).Value) = 0 Thenは一度追加してみましたが 上手く機能しませんでした。 やりたい事 ・数値が動いているけど、0.05以内の時は黄色 ・数値変動が0の場合は青 ・数値変動が0.05以上の場合は赤 です。 宜しくお願いします。

  • このVBAソースのどこが間違ってるか教えてください

    Dim csp As Integer 'ストップ Dim css As Integer 'ストップorスタート Sub Quest2() If css = 0 Then css = 1 Quest2a Else cstp = 1 css = 0 End If End Sub Sub Quest2a() Sheets("Sheet1").Select Range("B1:J10").Select Selection.Interior.ColorIndex = x1None Range("a1").Select cstp = 0 Do r = 1: c = 5 For i = 0 To 15 If i < 9 Then Cells(r, c).Interior.ColorIndex = x1None r = r + 1 If i < 5 Then c = c + 1 Else c = c - 1 End If Cells(r, c).Interior.ColorIndex = 3 Else Cells(r, c).Interior.ColorIndex = x1None r = r - 1 If i < 13 Then c = c - 1 Else c = c + 1 End If Cells().Interior.ColorIndex = 3 End If 'タイミング For tm1 = 1 To 1000: For tm2 = 1 To 100: Next If cstp = 1 Then Exit For End If Next DoEvents If cstp = 1 Then Exit For End If If r = 3 And c = 5 Then Cells(r, c).Interior.ColorIndex = x1None End If Next DoEvents If cstp = 1 Then Exit Do End If Loop Cells(10, 9) = Cells(r, c) Cells(10, 9).Interior.ColorIndex = 8 End Sub

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

     下記のようなコードで部品の管理をしています。条件が多くて少し複雑になっています。 とりあえずは、うまくできました。J列の結果だけが、うまくできません。 但し、J列の結果が(38はローズ )の表示がうまくいきません。(6の黄色)になってしまいます。 要するに、J列の結果が不がローズ色で、合が白色で、欠が薄いオレンジ色になればよいということなのです。 原因が分からず困ってしまって、お聞きする次第です。回答して頂けるものでしようか。 ご教授下されば幸いに存じます。よろしくお願いします。  Macro2 Macro マクロ記録日 : ' Sheets("sheet1").Select Columns("A:J").Select Selection.Copy Sheets("sheet2").Select Columns("A:J").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Sort Key1:=Range("H2"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin, DataOption1:=xlSortNormal Dim i As Long, LastRow As Long LastRow = Cells(Rows.Count, "A").End(xlUp).Row Range("J2:J" & LastRow).ClearContents '← E2:Jにすると、欠に全部なります、この設定もおかしいように思いますが? Range("E2:J" & LastRow).Interior.ColorIndex = 0 Application.ScreenUpdating = False Application.Calculation = xlCalculationManual '文言の詳細について '部品名と詳細-------------------------------------略称            'ghyu--------------------------------------←E列   'klub---------------------------------------←F列  'llpo----------------------------------------←G列  '合計個数(合計)-------------------------←H列  合計   '数量順位---------------------------------←I列   順位 '合格・不合格(合・不)欠品(欠)-----←J列  合・不・欠 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は ローズ    End If If Cells(i, "J") >= "合" Then Cells(i, "J").Interior.ColorIndex = 2 ' 2は  白色  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 セルをコピペすると画面がフリーズする

    お世話になります excelシート イベントでセルの値が変わった時にマクロが実行されるVBAを作成していて、 1行毎の入力作業はうまくいくのですが、式の入っていないセルを複数行をコピペ、 例えばA,Bセルの値が同じものが5件ほどあった場合、最初の入力のものをしたにドラッグして 貼り付けると、画面がフリーズして強制終了せざる負えなくなります。 エラーを回避する方法をご教示お願いいたします。以下VBAの内容です。 Dim sh1 As Worksheet Dim i As Integer Private Sub Worksheet_Calculate() 'detailに指標をセット i = 9 シートをworkエリアにセット Set sh1 = Worksheets(4) 'カードルシート,2ページ(予備)まで指標を回す For i = 9 To 66 '画面ちらつき防止 Application.ScreenUpdating = False '2ページ(予備)目ヘッダーは処理しない If i < 33 Or i > 41 Then 'サンプル番号が入力されている時 If sh1.Cells(i, "E") <> "" Then 'サンプル年月が入力されている時 If IsError(sh1.Cells(i, "K")) <> True Then '基準年月 >= サンプル年月 の時 If sh1.Cells(7, "O") >= sh1.Cells(i, "K") Then '次回サンプル年月 <= 当年月 の時 If sh1.Cells(i, "Q") <= sh1.Cells(8, "O") Then sh1.Cells(i, "M") = "出荷禁止" '該当行を赤色で塗りつぶし With sh1 .Cells(i, "A").Interior.ColorIndex = 3 .Cells(i, "B").Interior.ColorIndex = 3 .Cells(i, "C").Interior.ColorIndex = 3 .Cells(i, "D").Interior.ColorIndex = 3 .Cells(i, "E").Interior.ColorIndex = 3 .Cells(i, "F").Interior.ColorIndex = 3 .Cells(i, "G").Interior.ColorIndex = 3 .Cells(i, "H").Interior.ColorIndex = 3 .Cells(i, "I").Interior.ColorIndex = 3 .Cells(i, "J").Interior.ColorIndex = 3 .Cells(i, "K").Interior.ColorIndex = 3 .Cells(i, "L").Interior.ColorIndex = 3 .Cells(i, "M").Interior.ColorIndex = 3 End With Else '次回サンプル年月 <= 当年月 でない時 sh1.Cells(i, "M") = "OK" End If End If End If Else '該当行を無色で塗りつぶし With sh1 .Cells(i, "A").Interior.ColorIndex = 0 .Cells(i, "B").Interior.ColorIndex = 0 .Cells(i, "C").Interior.ColorIndex = 0 .Cells(i, "D").Interior.ColorIndex = 0 .Cells(i, "E").Interior.ColorIndex = 0 .Cells(i, "F").Interior.ColorIndex = 0 .Cells(i, "G").Interior.ColorIndex = 0 .Cells(i, "H").Interior.ColorIndex = 0 .Cells(i, "I").Interior.ColorIndex = 0 .Cells(i, "J").Interior.ColorIndex = 0 .Cells(i, "K").Interior.ColorIndex = 0 .Cells(i, "L").Interior.ColorIndex = 0 .Cells(i, "M").Interior.ColorIndex = 0 .Cells(i, "M") = "" End With End If End If Next i End Sub

  • マクロ 検索範囲を修正したい 1つ置きのセルで

    前に以下のマクロをここで教えていただきました。このときはB列からF列の範囲でお願いしたのですが、F列~AG列の1つ置きのセル(G、I、K・・・列)で検索したいです。どう修正したらよいですか?初心者なので調べても分からなかったので教えてください。 Sub Sample1() 'この行から Dim i As Long, j As Long, vL vL = InputBox("検索値を入力してください。") Application.ScreenUpdating = False Cells.Interior.ColorIndex = xlNone For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row For j = 2 To 5 With Cells(i, j) If .Value <> "" And .Value >= vL - 3 And .Value <= vL + 3 Then .Interior.ColorIndex = 36 End If End With Next j Next i Application.ScreenUpdating = True End Sub 'この行まで

  •  条件付き書式での色付けで以下のコードを教えて頂いたんですが、色付けを

     条件付き書式での色付けで以下のコードを教えて頂いたんですが、色付けを 適用する範囲をどうやって変更すればいいのでしょうか? もしよろしければ、範囲の変更の仕方と、コードの意味を教えて頂けますか? めんどうですがよろしくお願いします・・・。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Columns(3).Interior.ColorIndex = xlNone Dim i, j As Long For i = 1 To Cells(Rows.Count, 3).End(xlUp).Row For j = 1 To Cells(Rows.Count, 6).End(xlUp).Row If Cells(i, 3) = Cells(j, 6) Then Cells(i, 3).Interior.ColorIndex = Cells(j, 7).Interior.ColorIndex End If Next j Next i End Sub

  • EXCEL VBA2010 MsgBox

    Sub 重複() Dim i As Long, j As Long For i = 6 To 500 For j = 3 To 3 If WorksheetFunction.CountIf(Range("C6:C500"), Cells(i, j)) > 1 Then Cells(i, j).Interior.ColorIndex = 6 End If Next j Next i End Sub このVBAに重複が何件ありますよというメッセージを出したいです。 MsgBoxの入れ方を教えてください。

  • 行ごとに判定するマクロについて教えて下さい

    行ごとに判定するマクロについて教えて下さい。 下記のようなマクロで、添付ファイルのように、行ごとで E列からN列で違った数値がないか、入力されていないセルがないかを調べ 4つすべてのセルが同じ数値でない場合は塗りつぶしはされず O列にOKを表示しないようなマクロを組みたいのですが 現在のマクロだと、行ごとではなく、E3~N102セルまでの中で 同じ数値がないかを判断してしまっているため K11セルやK15セルのように数値が入力されていないにも関わらずO列の部分にOKが出てしまいます。 他の行に同じ数値が入っているのは関係なしにして 11行目なら11行目だけで 15行目なら15行目だけで、というように行ごに判定していくには どのようにすればいいでしょうか? Sub 判定マクロ回転() Dim i As Integer, j As Integer Range(Cells(3, 15), Cells(102, 15)).ClearContents For i = 3 To 102 For j = 5 To 14 Cells(i, j).Interior.ColorIndex = 0 If WorksheetFunction.CountIf(Range("E3:N102"), Cells(i, j)) > 3 Then If Cells(i, j).Row Mod 2 = 1 Then Cells(i, j).Interior.ColorIndex = 6 Cells(i, 15) = "OK" Else If Cells(i, j).Row Mod 2 = 0 Then Cells(i, j).Interior.ColorIndex = 40 Cells(i, 15) = "OK" End If End If End If Next j Next i If WorksheetFunction.CountIf(Range("O3:O102"), "OK") > 99 Then MsgBox "データチェックOK(^O^)b" End If End Sub

  • ExcelVBAで、選択範囲内で同じ値が入力されたセルを調べる

    選択範囲内(縦一列)で同じ値が入力されたセルの色を黄色にするプログラムを作りました。 Sub 選択範囲内で同じ値が入力されたセルを調べる_縦() Dim startrow As Byte Dim lasrow As Byte Dim i As Long Dim j As Byte Dim atai If TypeName(Selection) <> "Range" Then Exit Sub startrow = ActiveCell.Row '最初のセルの列番号を取得 lasrow = Selection.Rows(Selection.Rows.Count).Row '最終列番号を取得 '同じ値が入力されているセルを黄色にする For i = startrow To lasrow - 1 If ActiveSheet.Cells(i, ActiveCell.Column).Interior.ColorIndex = xlNone Then atai = ActiveSheet.Cells(i, ActiveCell.Column).Value For j = i + 1 To lasrow If atai = ActiveSheet.Cells(j, ActiveCell.Column).Value Then ActiveSheet.Cells(i, ActiveCell.Column).Interior.ColorIndex = 6 ActiveSheet.Cells(j, ActiveCell.Column).Interior.ColorIndex = 6 End If Next End If Next End Sub 但し、上記のプログラムでは選択範囲内に結合セルがあるとエラーになってしまいます。 どなたか、解決方法をご教授頂けませんでしょうか? 宜しくお願い致しますm(._.)m

専門家に質問してみよう