『ワークシート関数を標準モジュール内マクロで使用するには』(チョウチョ) Windows7 Excel2003 いつも大変お世話になっております。 マクロど素人ですが、質問をさせてください。 【シート構成】  ・台帳  ・作業シート  動作は、作業シートにあらかじめお客データが入力された状態で  下記のマクロを動作させると、台帳シートの「A列」のお客名 と  作業シートの「B列」のお客名をMatchさせて 検索値と参照値が等しい場合  作業シートの空欄となっている部分「C列 D列」へ 台帳シートの値を貼り付ける  といった動作をします。  ワークシート関数は、E列にあらかじめセットしてあり、マクロで呼び込まれたデータ  を基に値を表示させています。 【ワークシート関数】 動作:C2とI2の期間が1年以上の場合に「○」を表示 それ以外は「空白」 C2=開始日(日付データ) I2=終了日(日付データ) E2=IF(C2="","",IF(DATEDIF(C2,I2,"Y")>=1,"○","")) 【標準モジュールのコード】 Sub マッチング() 'c-検索キー Dim ws1 As Worksheet, ren1 As Range, c As Range Dim ws2 As Worksheet, ren2 As Range 'データーの検索値を格納 Dim ret As Variant '貼り付け先シート Set ws1 = Sheets("作業シート") '貼り付け先の項目範囲 Set ren1 = ws1.Range("B2:B50") '台帳のあるシート Set ws2 = Sheets("台帳") '台帳のデータ範囲(項目名を除いたリスト範囲) Set ren2 = ws2.Range("A2:V50") '入力範囲(貼り付け先の項目範囲)の個々のセルを順番に調べていく For Each c In ren1 'そのセルが空白(又は検索値にない)の場合 If IsEmpty(c.Value) Then '右隣の3列も値クリア c.Item(1, 2).Resize(, 3).ClearContents '空のセル ret = Empty Else 'セルc2の値がren2範囲の1列目にあるかを検索する '条件:検索テーブルは昇順に並び替えられている ret = Application.Match(c.Value2, ren2.Columns(1), 0) 'Application.Matchメソッドは見つかれば見つかった位置を数値で返す If IsNumeric(ret) Then '検索値と参照値が等しかったら If c.Value2 = ren2.Item(ret, 1) Then c.Item(1, 1).Offset(, 1).Value = ren2.Item(ret, 1).Offset(, 9).Value c.Item(1, 1).Offset(, 2).Value = ren2.Item(ret, 1).Offset(, 13).Value c.Item(1, 1).Interior.ColorIndex = 0 Else ret = "error" 'ret = False End If End If '(データ元範囲やI範囲に値がない)の場合は If Not IsNumeric(ret) Then 'セルc.Itemの色を赤にする c.Item(1, 1).Interior.ColorIndex = 3 End If End If Next '完了するまで繰り返す End Sub 【質問内容】 上記のワークシート関数を標準モジュール内にあるコード(ループ処理)内で 使用したいと考えております。 是非、アドバイスの程よろしくお願いします。 ※ループ処理はネットで探して自分の仕様に変更したものです。 ---- DATEDIF関数は、MATCH関数の様に VBA上で使えないので セルに数式をセットして、値にするのが簡単かもしれません。 たとえば Sub TEST1() Range("C1").Value = "=SUM(A1:B1)" Range("C1").Value = Range("C1").Value End Sub それにしても >If c.Value2 = ren2.Item(ret, 1) Then これって必要ですか? データが良く分からず、コードが読みにも不安があるのですが たとえば [A] [B] [C] [D] [E] [1] 表1 表2 [2] 名前 日付 検索値 [3] A 1月1日 A 1 ←=MATCH(D3,A3:A6,0) [4] B 1月2日 [5] C 1月3日 コード実行 [6] D 1月4日 ↑=IF(D3=INDEX(A3:A6,E3),"コード実行","error") こう言ったことですよね? 1.「A」をA3:A6の中の何番目に有るか探す。・・・・・・・・・・・・・・・・・E3 2.「A」がA3:A6の中の↑で見つかった位置にある文字と等しいか確認して                等しい場合はきめられたコードを実行する。・・・E5 現在、MATCH関数の三番目の引数に 0 を指定して「完全一致」で検索しているので MATCH関数の戻り値がエラー値で無かった場合、D3セルの値は E3の位置に必ず有ると思います。 (無かったら、#N/A エラーに成っているはずです。) >・台帳 ・作業シート それぞれのシートの状態と、サンプルデータを 一緒に載せておかれると良いかもしれません。 推測でマクロを動かすためのデータを作成することは出来ますが 確かなデータを使用して動かせた方が、間違いが少ないと思いますので。 (HANA) ----  HANA 様  早速のアドバイスありがとうございます。  サンプルコードを分からないまま使用していました。  今のところ問題なく動いていますが、おかしなところがありましたら  ご指摘よろしくお願いします。  シートの状況については、下記の通りまとめてみました。    【シート名:台帳】   [A]   ・・・   [J]   ・・・   [N]   ・・[V]   ┌────┬────┬────┬────┬────┬─────┐ [1] │ 氏名 │ ・・・ │ 開始日 │ ・・・ │ 項目× │ ・・・ │←項目行   ├────┼────┼────┼────┼────┼─────┤ [2] │ ネズミ │ ・・・ │ 4/1 │ ・・・ │ ○ │ ・・・ │   ├────┼────┼────┼────┼────┼─────┤ [3] │ ウシ │ ・・・ │ 3/1 │ ・・・ │ ・・・ │ ・・・ │   ├────┼────┼────┼────┼────┼─────┤ [4] │ トラ │ ・・・ │ 12/1 │ ・・・ │ ○ │ ・・・ │   ├────┼────┼────┼────┼────┼─────┤ [5] │ ウサギ │ ・・・ │ 5/15 │ ・・・ │ ・・・ │ ・・・ │   ├────┼────┼────┼────┼────┼─────┤ ・ │ ・ │ ・ │ ・ │ ・ │ ・ │ ・ │   ├────┼────┼────┼────┼────┼─────┤ ・ │ ・ │ ・ │ ・ │ ・ │ ・ │ ・ │   ├────┼────┼────┼────┼────┼─────┤ [50] │ ・ │ ・ │ ・ │ ・ │ ・ │ ・ │   └────┴────┴────┴────┴────┴─────┘    【シート名:作業シート】   [A]   [B]   [C]   [D]   [E]   ・・・   [I]   ┌────┬────┬────┬────┬────┬─────┬───┐ [1] │ NO │ 氏名 │ 開始日 │ 項目× │1年以上 │ ・・・ │終了日│   ├────┼────┼────┼────┼────┼─────┼───┤ [2] │ 4 │ トラ │ 12/1 │ ○ │ ・・・ │ ・・・ │10/30 │   ├────┼────┼────┼────┼────┼─────┼───┤ [3] │ 2 │ ネズミ │ 4/1 │ ○ │ ○ │ ・・・ │ 3/31 │   ├────┼────┼────┼────┼────┼─────┼───┤ [4] │ 3 │ ウサギ │ 5/15 │ ・・・ │ ○ │ ・・・ │ 7/31 │   ├────┼────┼────┼────┼────┼─────┼───┤ [5] │ 1 │ ウシ │ 3/1 │ ・・・ │ ○ │ ・・・ │ 2/28 │   ├────┼────┼────┼────┼────┼─────┼───┤ ・ │ ・ │ ・ │ ・ │ ・ │ ・ │ ・ │ ・ │   ├────┼────┼────┼────┼────┼─────┼───┤ ・ │ ・ │ ・ │ ・ │ ・ │ ・ │ ・ │ ・ │   ├────┼────┼────┼────┼────┼─────┼───┤ [50] │ ・ │ ・ │ ・ │ ・ │ ・ │ ・ │ ・ │   └────┴────┴────┴────┴────┴─────┴───┘  マクロで数式をセットして値変換するコードは下記の通り  Range("E2").Formula = "=IF(C2="""","""",IF(DATEDIF(C2,I2,""Y"")>=3,""○"",""""))"  Range("E2").Value = Range("E2").Value ※DATEDIF関数は、MATCH関数の様に VBA上で使えないので ※セルに数式をセットして、値にするのが簡単かもしれません。  の部分ですが、やはり数式をセットして値に変換するほうにしたいと思います。  Matchのコードと同じように、一気に書き込み変換したいと考えています。  例えば、「作業シート」の「C列」に値がある範囲に対応して「E列」へ数式をセットし値変換  といった具合になればと思っています。  申し訳ありませんがアドバイスの程よろしくお願いします。 ---- 訂正します "")>=3 ’3年以上 ↓ "")>=1 ’1年以上でした。 Range("E2").Formula = "=IF(C2="""","""",IF(DATEDIF(C2,I2,""Y"")>=1,""○"",""""))"  Range("E2").Value = Range("E2").Value ---- 済みません、これで何とか動いていますが コードの修正が必要でしたら教えていただけないでしょうか よろしくお願いします。 Range("E2").Formula = "=IF(C2="""","""",IF(DATEDIF(C2,I2,""Y"")>=3,""○"",""""))" Range("B2", Cells(rows.Count, 2).End(xlUp)).Offset(, 3).Formula = Range("E2").Formula Range("E2", Cells(rows.Count, 2).End(xlUp)).Value = Range("E2", Cells(rows.Count, 2).End(xlUp)).Value ---- おっと、衝突しちゃいました。。。。 どうせE列に数式を書き込むので C,D列にも数式を書き込み C:E列の数式を値変換。 その後、セルの色を変更します。 元のコードから結構かえてしまいましたが。。。 コード内に「Stop」を入れてあります。 マクロを実行すると、この行で一旦止まりますので 作業シートのB:E列の状態を確認してください。  C:Eに数式が入力され  それが値に変わり  B列の背景色が無くなり  B列の目的のセルに背景色が設定される 実際に使用される際は「Stop」の部分は消して下さい。 '------ Sub 数式を入れて() Dim ren1 As Range, c As Range Dim ren2 As String '★数式内で使用するため、文字列で設定 '貼り付け先の項目範囲 Set ren1 = Sheets("作業シート").Range("B2:B50") '台帳のデータ範囲(項目名を除いたリスト範囲) ren2 = "台帳!$A$2:$V$50" '数式をセット ren1.Offset(, 1).Formula = _ "=IF(ISERROR(VLOOKUP(B2," & ren2 & ",10,0)),"""",VLOOKUP(B2," & ren2 & ",10,0))" ren1.Offset(, 2).Formula = _ "=IF(C2="""","""",VLOOKUP(B2," & ren2 & ",14,0))" ren1.Offset(, 3).Formula = _ "=IF(C2="""","""",IF(DATEDIF(C2,I2,""Y"")>=1,""○"",""""))" Stop '計算結果を値化 ren1.Offset(, 1).Resize(, 3).Value = ren1.Offset(, 1).Resize(, 3).Value Stop 'セルの色をなくす ren1.Interior.ColorIndex = 0 Stop 'データ状況を確認しながら、セルに色を付ける For Each c In ren1 If c.Value <> "" And c.Offset(, 1).Value = "" Then c.Interior.ColorIndex = 3 End If Next End Sub '------ あ、Cells(rows.Count, 2).End(xlUp) を使いますか? でしたら、もう少しコードを変更してみましょうか。。。 (HANA) ---- Cells(rows.Count, 2).End(xlUp) を使ってみました。 他に With 〜 End With ってのも使ってみました。 たとえば、 >Range("E2", Cells(rows.Count, 2).End(xlUp)).Value = Range("E2", Cells(rows.Count, 2).End(xlUp)).Value これらのセルは、Sheets("作業シート") のセルの事なので Sheets("作業シート").Range("E2", Sheets("作業シート").Cells(Rows.Count, 2).End(xlUp)).Value = _ Sheets("作業シート").Range("E2", Sheets("作業シート").Cells(Rows.Count, 2).End(xlUp)).Value の様に書いておかないと、別のシートがアクティブな状態で実行した場合 そのシートのセルに対して処理が行われます。   マクロの実行は作業シートをアクティブにして行い   他のシートがアクティブに成っている事は無い   と言うなら、問題なく動くと思いますが。。。 すべてのセルの前に Sheets("作業シート") と書くと長くなって仕舞います。 そこで、 With でまとめることにします。 With Sheets("作業シート") .Range("E2", .Cells(Rows.Count, 2).End(xlUp)).Value = .Range("E2", .Cells(Rows.Count, 2).End(xlUp)).Value End With 「.」で始まる部分の「.」の前に With の後の物が省略されています。 ちなみに、Cells(Rows.Count, 2) なので、B列の最後のセルを確認しています。 なので これだと、B:E列の該当の範囲を .Value = .Value している事に成りますね。   B:D列には値しか無いはずなので、問題ないかもしれませんが。 '------ Sub 数式を入れて2() Dim c As Range Dim ren2 As String '★数式内で使用するため、文字列で設定 '台帳のデータ範囲(項目名を除いたリスト範囲) With Sheets("台帳") ren2 = .Name & "!$A$2:$V$" & .Cells(Rows.Count, 1).End(xlUp).Row End With With Sheets("作業シート") With .Range("B2", .Cells(Rows.Count, 2).End(xlUp)) '数式をセット .Offset(, 1).Formula = _ "=IF(ISERROR(VLOOKUP(B2," & ren2 & ",10,0)),"""",VLOOKUP(B2," & ren2 & ",10,0))" .Offset(, 2).Formula = _ "=IF(C2="""","""",VLOOKUP(B2," & ren2 & ",14,0))" .Offset(, 3).Formula = _ "=IF(C2="""","""",IF(DATEDIF(C2,I2,""Y"")>=1,""○"",""""))" Stop '計算結果を値化 .Offset(, 1).Resize(, 3).Value = .Offset(, 1).Resize(, 3).Value Stop 'セルの色をなくす .Interior.ColorIndex = 0 Stop 'データ状況を確認しながら、セルに色を付ける For Each c In .Cells If c.Value <> "" And c.Offset(, 1).Value = "" Then c.Interior.ColorIndex = 3 End If Next End With End With End Sub '------ ---- HANA さま サンプルコード ありがとうございます。 コード自体まだ解読していないのですが、早速動かしてみました。 ブレークできるので確認しやすかったです。 いま気づいたことは、言い忘れていたことなのですが、、、、 「参照元:台帳シート」の日付データは「空白」の場合もあります。 ですので、サンプルコードでは、空白部分の読み込み結果「M33.01.00」が返ってしまいました。 ---- その場合、ワークシート上で数式を入力するなら =IF(ISERROR(VLOOKUP(B2,台帳!$A$2:$V$50,10,0)),"",VLOOKUP(B2,台帳!$A$2:$V$50,10,0)) でなく(↑今コードが設定する数式) =IF(ISERROR(VLOOKUP(B2,台帳!$A$2:$V$50,10,0)),"",IF(VLOOKUP(B2,台帳!$A$2:$V$50,10,0)="","",VLOOKUP(B2,台帳!$A$2:$V$50,10,0))) こんな式にしますよね? ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~ 〜の部分のIF関数を追加してみてください。 D列の方の数式も変わってきますでしょうか? で、セルの色を変える判定は 別の方法が必要になりそうですね。 (HANA) ---- とは言え、セルの色をかえる判定で再度何らかの数式を使って確認するのなら 一旦「0」にしておいて セルの色を変える所で、セルの値を確認するので その時に削除してしまうのでも 良いでしょうか。 (数式を入れて2) のコードの 「データ状況を確認しながら、セルに色を付ける」の部分が For Each c In .Cells If c.Value <> "" Then '検索値が入力されている時で If c.Offset(, 1).Value = "" Then '検索値がなかった時 c.Interior.ColorIndex = 3 ElseIf c.Offset(, 1).Value = 0 Then '検索値は有ったが、日付の入力がなかった時 c.Offset(, 1).ClearContents '「開始」のセルの値を削除 End If End If Next に差し替え。 「.Offset(, 1).Formula = _」は、そのまま。 「.Offset(, 2).Formula = _」は、戻り値が""だったら、""にする。 "=IF(C2="""","""",IF(VLOOKUP(B2," & ren2 & ",14,0)="""","""",VLOOKUP(B2," & ren2 & ",14,0)))" 「.Offset(, 3).Formula = _」は、C2="" 又は C2=0 以外の時計算する。 "=IF(OR(C2="""",C2=0),"""",IF(DATEDIF(C2,I2,""Y"")>=1,""○"",""""))" (HANA) 2011/3/14 8:47 少し変更しました。 ---- HANA 樣 夜遅くから朝早くまで、お付き合いいただきましてありがとうございます。 今、職場からログを確認しました。 動作確認は、自宅に戻ってからになるかと思います。 ---- HANA 樣 遅くなりました、ようやく動作の方確認することができました。 数式を入れて2 のコード の方がわかりやすく使わせていただいております。 質問なのですが B列 C列 データの整合性チェック処理のコード部分に追加して・・・下方 '×××××××××××××××××××××××××××××××××××× 'セルの色をなくす .Interior.ColorIndex = 0 'Stop 'データ状況を確認しながら、セルに色を付ける また、値があっても日付がなければ、空白にする '※VLOOKUPの空白処理コードもあるが、こちらで処理した方がわかりやすい For Each c In .Cells '検索値が入力されている時で If c.Value <> "" Then '検索値がなかった時 If c.Offset(, 1).Value = "" Then '変数Cセルへ赤色を表示 c.Interior.ColorIndex = 3 '検索値は有ったが、日付の入力がなかった時 ElseIf c.Offset(, 1).Value = 0 Then '変数Cセルの隣にある値を削除 c.Offset(, 1).ClearContents End If End If Next 'セル単位の処理終了 End With '×××××××××××××××××××××××××××××××××××× 上のコードを参考にして E列にエラー が出た場合にセルに赤を表示させるようにしてみました。 動作自体は問題ないのですが 'セルの色をなくす-------------------------------------ネック .Interior.ColorIndex = 0 このコードを実行させると、B列の色がクリアされてしまいます。 どこか干渉しているのでしょうか? 一応「with〜endwith」処理範囲を限定しているのですが、何故かB列へ反映されてしまいます。 '××××××××××××××××××××××××××××××××××× With .Range("E2", .Cells(Rows.Count, 2).End(xlUp)) 'セルの色をなくす-------------------------------------ネック .Interior.ColorIndex = 0 Stop For Each c In .Cells If IsError(c) Then c.Interior.ColorIndex = 3 Exit Sub End If Next 'セル単位の処理終了 End With すみません。よろしくお願いします。 ---- >With Sheets("作業シート") > .Range("E2", .Cells(Rows.Count, 2).End(xlUp)).Value = .Range("E2", .Cells(Rows.Count, 2).End(xlUp)).Value >End With >ちなみに、Cells(Rows.Count, 2) なので、B列の最後のセルを確認しています。 >なので これだと、B:E列の該当の範囲を .Value = .Value している事に成りますね。 この部分が分かりますか? Cells(10,2)と言うと、B10セルの事になります。 RANGE("E2","B10")は、B2:E10 の範囲ですね。 なので、E列のセルの色をリセットすると同時に B:D列のセルの色もリセットされています。 考え方は色々あるので、分かりやすい物を使って貰うのが良いと思いますが。。。 Cells(Rows.Count, 2) が B10 と分かってから、E列までオフセットしても良いですし  .Cells(Rows.Count, 2).Offset(,3) その行だけを「.Row」で取り出して "E" と言う文字とくっつけて "E10" を作っても良いと思います。 "E" & .Cells(Rows.Count, 2).Row よく使われるのは、Resize で、これは ワークシート関数のOFFSET関数の =OFFSET(基準,行数,列数,高さ,幅) ~~~~~~~ここの部分に相当します。 Range("E2").Resize(2) これで E2:E3 の範囲 です。 Range("E2").Resize(10) だと、E2:E11 の範囲の事に成ってしまうので Range("E2").Resize(10 -1) します。これで、E2:E10 の範囲に成るので .Range("E2").Resize(.Cells(Rows.Count, 2).Row -1) と言う感じで書けます。 でも、ループを二回もする必要は無いと思います。 E列にエラーが出るのは、どう言った時でしょう? '検索値が入力されている時で If c.Value <> "" Then の時でしょうか? それとも、それ以外でもエラーに成る事が有るのでしょうか? セルcから見ると、E列は3つ隣の列なので If IsError(c.Offset(,3)) Then の形で、B列に色を付けるのと同じループで出来ると思います。 ループ処理の前の セルの色を消すときに、今はB列しか消してませんが E列も消すようにする必要が有りますが。 (HANA) ---- HANA 様 ご指導ありがとうございます。  =OFFSET(基準,行数,列数,高さ,幅)    ぼんやりですが、理解してきたような気がします。 E列のエラー表示ですが、日付の開始〜終了日の計算で「#NUM!」となります。   関数を入力するときにISErrorで回避することは出来るのかなとは思います。   だた、エラー時に着色をしたかったので ループ処理時にできないかな??と思った次第です。 でっアドバイスいただいた結果   下記の通りに、とりあえず組み込んでみました。   希望の通りに動いてはいますが、構文がへんてこな部分があるかもしれませんので アドバイスお願いします。 '××××××××××××××××××××××××××××××××××× 'B列セルの色をなくす .Interior.ColorIndex = 0 'B列から右となり3列目セルの色をなくす .Offset(, 3).Interior.ColorIndex = 0 '←----------------【E列の色クリア】追加 Stop 'データ状況を確認しながら、セルに色を付ける また、値があっても日付がなければ、空白にする '※VLOOKUPの空白処理コードもあるが、こちらで処理した方がわかりやすい For Each c In .Cells '検索値が入力されている時で If c.Value <> "" Then '検索値がなかった時 If c.Offset(, 1).Value = "" Then '変数Cセルへ赤色を表示 c.Interior.ColorIndex = 3 '検索値は有ったが、日付の入力がなかった時 ElseIf c.Offset(, 1).Value = 0 Then '変数Cセルの隣にある値を削除 c.Offset(, 1).ClearContents End If '変数cセルから右隣3列目がerror時'←--------------【E列のerror処理】追加 If IsError(c.Offset(, 3)) Then '変数cセル右隣3列目のセルに赤色を表示 c.Offset(, 3).Interior.ColorIndex = 3 Exit Sub End If End If Next 'セル単位の処理終了 End With ---- HANA 様 済みません、下記へ修正しました。 よろしくお願いします。 'B列セルの色をなくす .Interior.ColorIndex = 0 'B列から右となり1列目セルの色をなくす .Offset(, 1).Interior.ColorIndex = 0'←-------------【クリア】追加 'B列から右となり3列目セルの色をなくす .Offset(, 3).Interior.ColorIndex = 0 Stop 'データ状況を確認しながら、セルに色を付ける また、値があっても日付がなければ、空白にする '※VLOOKUPの空白処理コードもあるが、こちらで処理した方がわかりやすい For Each c In .Cells '検索値が入力されている時で If c.Value <> "" Then '検索値がなかった時 If c.Offset(, 1).Value = "" Then '変数Cセルへ赤色を表示 c.Interior.ColorIndex = 3 '検索値は有ったが、日付の入力がなかった時 ElseIf c.Offset(, 1).Value = 0 Then '変数Cセルの隣にある値を削除 c.Offset(, 1).ClearContents '変数Cセルの隣にある値を赤表示 c.Offset(, 1).Interior.ColorIndex = 3'←-------------【赤色】追加 '検索値は有ったが、変数cセル右3列目セルがエラー時 ElseIf IsError(c.Offset(, 3)) Then'←-------------【エラー処理】ここへ変更 '変数cセル右隣3列目のセルに赤色を表示 c.Offset(, 3).Interior.ColorIndex = 3 End If End If ---- あっ、「Exit Sub」について書いてたんですが。。。 −−−−−−−−−−−−−−−−−−−−−−−−−−−−−−− えぇっと。。。。 If IsError(c.Offset(, 3)) Then Exit Sub End If Exit Sub しちゃってるみたいですが、大丈夫ですか? 最初のエラーが見つかったら、マクロが終了して仕舞いますよ? コードを実行すると、Stop の所で止まります。 そこから [F8] を押すと、一行ずつコードが実行されます。 また、Stop と入力するのではなく、ブレークポイントを設定する事も出来ます。  コードを入力するところの左側に 灰色の部分が有ると思います。  そこをクリックすると 茶色の● が表示されますが  コードを実行した時、その行で一旦止まります。 それから、最初から [F8] で実行する事も出来ます。 E列の上の方でエラーが出るようにしておいて [F8]で一行ずつ動きを確認すると 途中でコードが終わってしまっているのが分かると思いますが。 −−−−−−−−−−−−−−−−−−−−−−−−−−−−−−− まぁ、F8で実行するのは やってみてもらうと良いと思います。 それと、c.Offset(, 3) は、値を参照するので c.Offset(, 3).Value でしたね。。。 後は、見た感じ それで良いように思います。 B,C,E列のセルの色をなくすのは、 D列のセルに色が付けてないなら Resizeを使って一辺に色を消しても良いかもですね。 With B列の範囲        ・・・・って成ってるので  .Resise(, 4).Interior.ColorIndex = 0   ・・・って感じで。 (HANA) ---- HANA さま アドバイスありがとうございました。 やりとりの結果、たたき台もできて今のところエラーも出ていません。 あとは工夫しながら、取り組みたいと思います。 解決です。 (チョウチョ)