『指定の列を塗りつぶす』（VBA初心者） Excel2010 Win7 今日の日付の列を塗りつぶしたいのですが、教えていただけませんか？ 下記の何処に手を加えれば良いのでしょうか？ Private Sub Workbook_Open() 　Dim FRng As Range 　Const TagetSheet = "スケジュール" ' <-- 対象シート名指定 　Worksheets(TagetSheet).Activate 　Set FRng = Rows("1:2").Find(Date, LookIn:=xlFormulas) 　If Not FRng Is Nothing Then 　　FRng.Offset(1).Activate ' <---今日の見出しの次行の場合 　Else 　　MsgBox "今日の日付が見つかりません。", vbExclamation 　End If 　Set FRng = Nothing End Sub ---- Rows("1:2")　この意味は？　日付は１行目か２行目にある？ FRng.Offset(1).Activate で、１行目にあった場合は　2行目を選択して、２行目にあった場合は３行目を選択？ それと、色を塗るということだけど、そのために Activate をする必要はないよ？ 色塗りだけのことであれば、（↑でいったことは心配だけど） FRng.Offset(1).Activate これをやめて FRng.Offset(1).Interior.ColorIndex = 6 とか。 でも、昨日、ブックを開いていれば昨日の日付のところに色が塗られているはずだね？ それでいいなら構わないけど、色は今日の日付のところだけなら、このプロシジャの最初に 色塗り対象の領域.Interior.ColorIndex = xlNone というのを記述して、消しておこう。 (ぶらっと) ---- （ぶらっと）さん、ありがとうございます。 VBA初心者です。 サンプルから引用したため、内容は詳しくは分かりません。 日付はsheet1のG3行目に1月1日から記載してあります。 ファイルオープン時に今日の日付を検索し、カーソルを移動しています。 ご指摘の通り、昨日の塗りつぶしを消したいです。 よろしくおねがいします。 ---- G3から右に、３行目に日付。該当の日付の１つ下の４行目のセルを色塗りということで。 Private Sub Workbook_Open() Dim z As Variant With Sheets("Sheet1") With .Range("G3", .Cells(3, .Columns.Count).End(xlToLeft)) .Offset(1).Interior.ColorIndex = xlNone z = Application.Match(CDbl(Date), .Cells, 0) If IsNumeric(z) Then .Cells(z).Offset(1).Interior.ColorIndex = 6 '好きな色を Else MsgBox "今日の日付が見つかりません。", vbExclamation End If End With End With End Sub (ぶらっと) ---- ＶＢＡの勉強をかねてということならいいけど、本件はマクロを使わずとも 日付欄の下の、G4から始まる４行目のセルを選択して、条件付き書式。 「数式が」=G3=TODAY() で、色を好きなものに。 これでできるよ。 (ぶらっと) ---- （ぶらっと）さん、ありがとうございます。 VBA初心者です。 回答ありがとうございます。 条件書式だとファイル動作が重くなり過ぎたため、VBAで対応できないかと思いました。 塗りつぶしですが、行ではなく、1列の塗りつぶしは可能でしょうか？ ---- （ぶらっと）さん、ありがとうございます。 VBA初心者です。 ついでに申しますと、 土曜の列と日曜の列それぞれに塗りつぶしを行いたいです。 土曜：青 日曜：赤 恐れ入りますが、教えてください。 よろしくお願いします。 ---- >塗りつぶしですが、行ではなく、1列の塗りつぶしは可能でしょうか？ 何行目から何行目を塗りつぶす？ >土曜の列と日曜の列それぞれに塗りつぶしを行いたいです。 この意味は？ 今日の日付に加えて？　それとも、塗りつぶすのは今日の日付の列のみ。ただし、土曜なら青、日曜なら赤、それ以外なら黄色とか？ (ぶらっと) ---- （ぶらっと）さん、ありがとうございます。 VBA初心者です。 Excelも初心者なのですが、 Excelで列を選択して塗りつぶしを行う状態は、VBAではできないのでしょうか？ できないのであれば、1行目から1000行目まででお願いします。 ファイルオープン時に 今日の日付を黄色に塗りつぶし、 土曜、日曜も塗りつぶしたいです。 次から次へと申し訳ありません。 ---- >Excelで列を選択して塗りつぶしを行う状態は、VBAではできないのでしょうか？ >できないのであれば、1行目から1000行目まででお願いします。 いやいや。できるよ、もちろん。 でも列全体を塗りつぶすと、１行目から１、０４８、５６７行目までの塗りつぶしになるので、 それは困るといわれそうだったから聞いたもの。 >ファイルオープン時に >今日の日付を黄色に塗りつぶし、 >土曜、日曜も塗りつぶしたいです。 了解。昼ごはんを食べてからコードを書くね。 早食い終了。 Private Sub Workbook_Open() Dim z As Variant Dim c As Range Dim myColor As Long Dim ok As Boolean With Sheets("Sheet1") .Cells.Interior.ColorIndex = xlNone For Each c In .Range("G3", .Cells(3, .Columns.Count).End(xlToLeft)) myColor = 0 If c.Value = Date Then myColor = vbYellow ok = True Else Select Case Weekday(c.Value) Case vbSunday myColor = vbRed '強烈過ぎれば vbMagenta でも Case vbSaturday myColor = vbBlue '強烈過ぎれば vbCyan でも。 End Select End If If myColor Then c.EntireColumn.Interior.Color = myColor Next If Not ok Then MsgBox "今日の日付が見つかりません。", vbExclamation End With End Sub (ぶらっと) ---- （ぶらっと）さん、ありがとうございます。 VBA初心者です。 凄いです！ 思った通りの出来栄えです。 ありがとうございました。 ぶらっとさんのように人に教えられるように学びたいと思います。 今後ともよろしくお願い致します。 ---- （ぶらっと）さん、ありがとうございます。 VBA初心者です。 すみません ファイルオープン時に土日以外の塗りつぶしが消えちゃいます。 どうしたらよいでしょうか？ ---- >ファイルオープン時に土日以外の塗りつぶしが消えちゃいます。 ん？？？？？？ オープン時に、土日と今日の日付の列に色塗り。その前に、すべての列の色を消してはいるけど？ シート上に、土日以外にもいろいろ色がついてるの？ たまたま偶然だけど、並行して以下のお手伝いをしている。 [[20130325160906]]　『セルに日付を入力すると入力された日に★マークが』（sonson） ここでも、色を付けたいところはできたけど、○○○につけてあった色がきえてしまった！ こんなレスのやり取りをしている。 基本的に、この種の処理、実行時の条件によって特定の場所の値をかえるとか、色をつけるとか、 そういった処理は、実行前には、前回の条件で色がついていたり、値がせっとされたりしているので まずは、それらをクリアして、実行時の条件に従って、あらためて色を付けたり、値をセットしたりする。 というか、アップしたコードは、そういう流れにしている。 一番最初の　.Cells.Interior.ColorIndex = xlNone　ここで【シート上のすべてのセルの】色を消している。 もし、G列より右の列だけとか、G列〜3行目の値がある最後のセルの列まで　とか、そういう限定ができるなら 対応するけど。 あるいは、こういった列には、こういった色が固定でつけられているので、けしては困るとか、そういった条件を 明示してくれたら、対応はできるけどね。 (ぶらっと) ---- （ぶらっと）さん、ありがとうございます。 VBA初心者です。 私もsonsonさんと同じように横に日付を記載しています。 G1：1/1 〜 NG1：12/31 G1〜NG1の4行目以下に色塗りつぶしを行っております。 ---- >G1：1/1 〜 NG1：12/31 ん？　日付があるのは３行目じゃなかった？ それはともあれ、４行目より下のデータ行の、【不特定の場所】に【不特定の色】をつけてあって それらは消したくないということなのかな？ これは、結構しんどいかもね。 まず、たとえば J10 のセルに何かしら色をつけていたとする。たとえばピンク。 で、ある日、ブックを開いた時点で、このJ列が　今日だったとする。アップしたコードでは、この J列が黄色に塗られる。 で、その日、作業が終わって、このブックを保存して閉じたとしよう。 次の日に開くと、【今日】は、K列になっているよね。 なので、K列を黄色く塗るのはいいんだけど、もう J列は今日じゃないので、色を消すよね。 そのとき、J10 は、一昨日の状態、つまりもともと塗ってあったピンクに戻す？ これは、しびれるよ。一昨日、どんな色が塗られていたのか、それは、マクロからはうかがいしれないので。 これをやるなら、「土日」と「今日」の色塗りは、【条件付き書式】でやったほうがいい。 もちろん、土日と今日の列のみに限定するので、重くなるのは最低限にする。また、行も、最終行までじゃなく １，０００行目までということにしたほうが、もっと軽くなるけど。 ただし、これをやるとしても、処理前に、いったん前回の状態で設定されていた条件付き書式を消すところから スタートするので、このシートには、他の目的の条件付き書式がないというのが前提になるけど。 ところで、sonsonさんと、同じテーマに取り組んでいるの？ それとも、偶然の一致？　まぁ、どちらでもいいんだけど。 (ぶらっと) ---- （ぶらっと）さん、おはようございます。 VBA初心者です。 昨日コメントしたつもりが反映されておりませんでした。 ごめんなさいです。 どちらかと言うと、sonsonさんとのやり取りを見つけて、 自分のにも取り入れようと思いました。 仕様としては、 ファイルオープン時に土日の列を塗りつぶし、 今日の日付も塗りつぶし、今日を表示させる。 sheet1で、 日付 G1：1/1 〜 NG1：12/31 E4行目に第一希望日を入力すると、○を書き、塗りつぶす。 F4行目に第二希望日を入力すると、★を書き、塗りつぶす。 ぶらっとさんは、引っ張りだこで忙しいと思いますが、 よろしくお願いします。 ---- ---- 忙しくはないんだけど、どう実装しようかと悩んでて。 というより、そちらの【色塗り】の実態と、希望要件が、まだしっくり頭に入らない。 別トピはは、レイアウトが似ているようだけど、根本的には ・あらかじめ対象領域の列単位に、土曜日列色だとか日曜日列色だとか、特定日列色だとかが塗られていて 　条件によって【あるセル】の色を塗る。条件がかわれば、新しい条件に基づいたセルに色塗りするとともに 　前の条件で塗られていたセルの色を【元に戻す】 ・ということで、あらかじめ、その列に塗ってある色が日付行にも塗られていて、そこは不変。 ・何よりも【本日】がない。 本トピは、あらかじめ土日や本日列には色が塗られていないけど、それらとは関係なく、様々なセル（列？）に、いろんな色が塗られている。 で、ブックを開いたときに、土日列、本日列に色を塗る。 明日になれば（あるいは日付行が変わって土日の列が変更になっている場合もある？）前回のそれらを消して 今日という日付と、その時点での日付行の曜日で、色を塗りなおす。 でも、それらとは無関係に塗られていたセル（列？）の色は復元しなきゃいけない。 ↑でもコメントしたけど、ピンクに塗られていたセル（列？）が、ある日、【本日】なので黄色に塗る。 でも、明日になれば、そこは本日じゃないので黄色を消す。でも、一昨日はピンクだったので、それに戻さなきゃいけない。 ここを、どう実現するか・・・？？ 要件が明確になれば、いかようにも実現手段はあるけど、そもそも、本トピで相手にしているシートには どこに、どんな形で、土日や本日以外の色が塗られているのか？？ それがわからないので、なんともできないというのが現状。 >E4行目に第一希望日を入力すると、○を書き、塗りつぶす。 >F4行目に第二希望日を入力すると、★を書き、塗りつぶす。 これは、当初のテーマとは、まったく、【かけ離れた要件。】 もちろん、やりたいことを、より具体的に説明してくれれば、追加することはできないことはない。 心配なのは、こちらでは【かけ離れた要件】という理解だけど、そちらでは、本トピのテーマを実現する方策だと 考えている？　そうなると、レイアウトや要件そのものにたいして、こちらとそちらの認識が大きくずれていることになる。 もう一度、シートの実態がどうなっているか、それに対して、いつ、どんなタイミングで、どう色塗りしたいのか あるいは、色塗りをもとにもどしたいのか、具体的に説明してくれないかな？ (ぶらっと) ---- （ぶらっと）さん、おはようございます。 VBA初心者です。 仕様としては、 sheet1 に予め G1：1/1 〜 NG1：12/31 に日付を入力しておきます。 ファイルオープン時に土日の列を塗りつぶし、 今日の日付の列も塗りつぶし、今日を表示させる。 E4行目に第一希望日を入力すると、○を書き、塗りつぶす。 F4行目に第二希望日を入力すると、★を書き、塗りつぶす。 日付を変更した場合、元のセルをクリアにする。 日付が変更され、翌日になった場合、 昨日の列の塗りつぶしは解除される。 昨日が土日だった場合は、要注意ですね。 ○マーク及び塗りつぶしのセルは保持される。 ★マークのセルも同様に保持。 つたない説明で分かりましたでしょうか？ よろしくお願いします。 ---- ThisWorkbookモジュールを総入れ替え。 要件勘違いしてるなら指摘乞う。 なお、対象のシート名や、各色は、先頭のConstで規定しているので、ここは実態に合わせていかようにも変更してね。 Option Explicit Const SunColor As Long = vbRed Const satColor As Long = vbBlue Const dayColor As Long = vbYellow Const inEColor As Long = vbGreen Const inFColor As Long = vbCyan Const MYSHNAME As String = "Sheet1" '対象シート名 Private Sub Workbook_Open() Dim rE As Range, rF As Range, rX As Range Dim z As Long Dim myColor As Long Dim c As Range Dim ok As Boolean Application.EnableEvents = False With Sheets(MYSHNAME) 'いったん色を全てクリア .Cells.Interior.ColorIndex = xlNone '土日色と本日色のセット For Each c In .Range("G1", .Cells(1, .Columns.Count).End(xlToLeft)) myColor = 0 If c.Value = Date Then myColor = dayColor ok = True Else Select Case Weekday(c.Value) Case vbSunday myColor = SunColor Case vbSaturday myColor = satColor End Select End If If myColor Then c.EntireColumn.Interior.Color = myColor Next z = WorksheetFunction.Max(4, _ .Range("E" & .Rows.Count).End(xlUp).Row, _ .Range("F" & .Rows.Count).End(xlUp).Row) 'E,F列の日付入力欄の日付による色を復元 For Each c In .Range("E4:F" & z) If IsDate(c.Value) Then Call setColor(c) Next End With Application.EnableEvents = True If Not ok Then MsgBox "今日の日付が見つかりません。", vbExclamation End Sub Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal target As Range) Dim r As Range Dim c As Range Dim myColor As Long If Not sh Is Sheets(MYSHNAME) Then Exit Sub If target.Columns.Count = sh.Columns.Count Then Exit Sub ' 行削除、挿入 If target.Rows.Count = sh.Rows.Count Then Exit Sub '列削除、挿入 Set r = Intersect(target, sh.Columns("E:F"), sh.Rows("4:" & sh.Rows.Count)) If r Is Nothing Then Exit Sub 'E,F列の4行目以下のみ Application.EnableEvents = False For Each c In r.Cells Call setColor(c, True) Next Application.EnableEvents = True End Sub Private Sub setColor(target As Range, Optional repaint As Boolean = False) Dim myColor As Long Dim myMark As String Dim c As Range Dim fd As Date Dim td As Date If target.Column = 5 Then 'E列 myColor = inEColor myMark = "○" Else myColor = inFColor myMark = "★" End If If repaint Then For Each c In target.EntireRow.Range("G1:NG1") If c.Interior.Color = myColor Then c.ClearContents c.Interior.ColorIndex = xlNone With c.Offset(1 - c.Row) 'このセルの列の１行目のセル If .Interior.ColorIndex <> xlNone Then c.Interior.Color = .Interior.Color End With '↑の３行は2003なら以下の1行でもＯＫ 'c.Interior.ColorIndex = c.Offset(1 - c.Row).Interior.ColorIndex 'このセルの１行目 End If Next End If fd = target.Parent.Range("G1").Value td = target.Parent.Range("NG1").Value '入力によりマークと色をセット If IsDate(target.Value) Then If target.Value >= fd And target.Value <= td Then target.EntireRow.Cells(target.Value - fd + Columns("G").Column).Value = myMark target.EntireRow.Cells(target.Value - fd + Columns("G").Column).Interior.Color = myColor End If End If End Sub (ぶらっと) ---- （ぶらっと）さん、ありがとうございます。 VBA初心者です。 素晴らしい内容です。 追加で1点 F4行目に入力した日付を削除した場合、全画面をリフレッシュすることは可能でしょうか？ 実は、 F5行目移行にF4行目を参照しております。 F5に=F4+1を入力しているため、手動でリフレッシュしなければなりません。 お手数ですが、教えてください。 よろしくお願いします。 ---- 削除とは？？ F4セルを削除？　それとも F4セルをクリア？　それとも F4セルの日付を変更？ F5 の式は正確には、どんな式？ =F4+1 だけなら 1900/1/1 とか にならない？ また、セルの削除だとすると #REF! になるだろうし？ 【リフレッシュ】の意味は？現在のコードは式による値の変更では動かないので、その場合も つまり、F4 の値が変更になった時,F5より下の日付に対しても処理したいというのならわかるけど？ (ぶらっと) ---- 一応、F4 が変更になった時、式によってかわっているF5以降を処理するという理解で。 Workbook_SheetChange の最後の　Application.EnableEvents = True　の下に If Not Intersect(target, Range("F4")) Is Nothing Then Application.OnTime Now(), "'Refresh """ & MYSHNAME & """'" で、標準モジュールに以下を。 Sub Refresh(shn As String) With Sheets(shn) With .Range("F5", .Range("F" & .Rows.Count).End(xlUp)) .Formula = .Formula End With End With End Sub (ぶらっと) ---- （ぶらっと）さん、ありがとうございます。 VBA初心者です。 標準モジュールってどこですか？ 本当に初心者で申し訳ありません。 ---- VBE画面のメニューの挿入(I) --> 標準モジュール(M) を選んででてくるところ。 普通のマクロは、ここに記述する。 今までの ThisWorkbookモジュールは、ちょっと特殊な目的で使う場所。 (ぶらっと) ---- 以下、参考まで。 http://officetanaka.net/excel/vba/beginner/10.htm http://www.happy2-island.com/excelsmile/smile01/capter00400.shtml 他にも、｢マクロはどこに書くか｣あたりで検索すると、たくさんの情報がヒットするよ。 (ぶらっと) ---- （ぶらっと）さん、ありがとうございます。 VBA初心者です。 返信遅くなり、申し訳ありませんでした。 体調不良で寝込んでました。 まだ完全ではないので、教えていただいた内容を検証していません。 来週になりますが、またお願いします。 ---- （ぶらっと）さん、お久しぶりです。 VBA初心者です。 F列の日付の変更箇所が複数ありますので、前回教えていただいた標準モジュールの追記は諦めます、 ボタン押下で、再起動する形に変更しました。 Private Sub CommandButton2_Click() Range("G3:NG9999").Clear ActiveWorkbook.Save Workbooks.Open Filename:="\\作業シート.xlsm" End Sub ですが、 これを実行すると「G3:NG9999」がクリアされたままで、 土日の塗りつぶしや日付のマークなどが表示されません。 なにか良い手立てはありませんでしょうか？ お手数ですが、教えていただけないでしょうか？ お願いします。 ---- >F列の日付の変更箇所が複数ありますので、前回教えていただいた標準モジュールの追記は諦めます、 う〜ん・・・それは、いかにも、もったいないねぇ。 どことどこが変更になる結果、どことどこが自動計算されるんだということを網羅して教えてくれれば それなりに対応できると思うんだけど？ で、今回の質問だけど ・Range("G3:NG9999").Clear　これはなぜ行っているのかな？ ・ActiveWOrkbook というのは、もちろん、マクロブックだよね。 ・で、そのマクロブックが　"\\作業シート.xlsm"　なのかな？ 要は、Private Sub Workbook_Open　でやっていることを、改めて実行するために開きなおしたいということかな？ でも、残念ながら、このコードでは、Workbook_Open は実行されない。 いくつか方法がある。まっとうな方法１、まっとうな方法２。ちょっと、これらは説明だけではわかりにくいと思うので 必要ならコードをアップする。 姑息な方法　としては、現在　Private Sub Workbook_Open()　となっているのを　Public Sub Workbook_Open() に変更。 で、 Range("G3:NG9999").Clear ActiveWorkbook.Save Workbooks.Open Filename:="\\作業シート.xlsm" これをやめて、かわりに　ThisWorkbook.Workbook_Open　と記述。 でも、そもそもが、当初の方針をあきらめずに、なんとかしたほうがいいと思うんだけどね。 (ぶらっと) ---- 下からお邪魔します。 条件付書式を重いとはなから切リ捨てていますが3種類くらいなら遅くは ならないと思います。 条件付書式が重くなる主要因は、設定範囲より条件の累計の数ですから。 シートを全選択した状態で（カーソルはA1）数式で下記の式を設定、 　 =A$3=TODAY() 　・・・ 今日の色 　 =WEEKDAY(A$3)=1 ・・ 日曜の色 　 =WEEKDAY(A$3)=7 ・・ 土曜の色 条件を満たす場合は停止にすべてチェック でやってみて、遅くなりますか？ 遅くなる場合や、あくまでマクロで解決したい場合は読み捨て下さい。 (Mook) ---- Mookさん VBA初心者です。 ありがとうございます。 ぶらっとさんに聞く前に試したのですが、重くなり過ぎて断念しました。 VBAで行った方がやはり軽いです。 ---- （ぶらっと）さん、ありがとうございます。 VBA初心者です。 ファイル添付できれば一番分かり易いのですが、 A3を参照して、VLOOKUPで、E3とF4に日付を入れています。 不特定多数のAnも同様に行っております。 Anをリスト選択を行うごとにEn値とFn値も変わります。 An変更後、即座にマーク等も更新したいのですが、 まっとうな方法で教えていただけないでしょうか？ よろしくお願いします。 ---- >まっとうな方法で教えていただけないでしょうか？ 書いた後、はたして『まっとうな方法かどうか』ぎもんになってきた。 少し時間をもらえればコード案アップするけど。 また、「姑息な方法」と書いたけど、そんなに姑息でもないかな？ そちらを、まず試してみてくれる？ (ぶらっと) ---- （ぶらっと）さん、ありがとうございます。 VBA初心者です。 >Public Sub Workbook_Open() に変更 →変更後、動作問題なしです。 が、 >かわりに　ThisWorkbook.Workbook_Open　と記述。 →コンパイルエラー：メソッドまたはデータメンバーが見つかりません。と表示されます。 （T。T) ---- >コンパイルエラー：メソッドまたはデータメンバーが見つかりません。と表示されます。 そんなことは、あり得ないと思うけど。 このコードが書かれているモジュールはシートモジュールだと思うけど、シートモジュールであれ、標準モジュールであれ ThisWorkbook.Workbook_Open この記述で実行されるよ。Workbook_Open のつづりが間違っているとか？ （アンダーバーをハイフンにしていたり） (ぶらっと) ---- （ぶらっと）さん、おはようございます。 VBA初心者です。 ボタンを押したら動作するようにしています。 Public Sub CommandButton2_Click() Range("G3:NG9999").Clear ActiveWorkbook.Save ThisWorkbook.Workbook_Open End Sub ---- >Public Sub CommandButton2_Click() ここは、Public にせずとも、Private のままでいいんだけど、お願いしたのは ThisWorkbookモジュールの Private Sub Workbook_Open() 0--> Public Sub Workbook_Open() なんだけど？ そうしてくれて、なおかつ　タンバーが見つからない？ (ぶらっと) ---- （ぶらっと）さん、お疲れさまです。 VBA初心者です。 ごめんなさい。 わからないです。 前述のPGを修正していただけないでしょうか？ 申し訳ありません。 ---- >前述のPGを修正していただけないでしょうか？ いやぁ、そんな難しいことを言っているのではなく、今、Thisworkbook モジュールが 以下のようになっていると思うんだけど Option Explicit Const SunColor As Long = vbRed Const satColor As Long = vbBlue Const dayColor As Long = vbYellow Const inEColor As Long = vbGreen Const inFColor As Long = vbCyan Const MYSHNAME As String = "Sheet1" '対象シート名 Private Sub Workbook_Open() '★<=== ここだけ修正。 Dim rE As Range, rF As Range, rX As Range Dim z As Long Dim myColor As Long Dim c As Range Dim ok As Boolean Application.EnableEvents = False With Sheets(MYSHNAME) 　（省略) End SUb この　Private Sub Workbook_Open()　を　Public Sub Workbook_Open() になおす。 で、シートモジュール（だよね？）に書いた　CommandButton2_Click()　は　以下のように。 Private Sub CommandButton2_Click() ThisWorkbook.Workbook_Open End Sub (ぶらっと) ---- （ぶらっと）さん、ありがとうございます。 VBA初心者です。 ありがとうございます。 正常に再表示されるようになりました。 ありがとうございます。 可能でしたら、更新ボタンを押下しなくても 日付が変更になったら即、再表示されるようなPGを作っていただけないでしょうか？ よろしくお願いします。 ---- （ぶらっと）さん、おはようございます。 VBA初心者です。 色を変えたいのですが、 Const SunColor As Long = vbRed Const satColor As Long = vbBlue Const dayColor As Long = vbYellow Const inEColor As Long = vbGreen Const inFColor As Long = vbCyan 　↓に変更するとエラーとなります。 Const SunColor As Long = RGB(255, 153, 204) Const satColor As Long = RGB(204, 255, 255) Const dayColor As Long = RGB(255, 255, 204) Const inEColor As Long = RGB(204, 255, 204) Const inFColor As Long = RGB(255, 153, 0) 何か方法はありますでしょうか？ 教えてください。 ---- とりあえず色の件を。 Const は　【定数】なので、【固定値】を宣言しなきゃいけない。 Arrayは関数なので。（でも、こういう書き方ができても、悪くはないと思うけどね） たとえば Dim SubColor As Long と、宣言を変えて Workbook_Open の先頭あたりに SunColor = RGB(255, 153, 204) このようにするか、あるいは、COnstのままのほうがよければ、RGB関数で作成される数値を指定する。 たとえば　RGB(255, 153, 204) なら　 Sub Test() MsgBox RGB(255, 153, 204) End Sub こんなコードで番号を調べて、 Const SuColor As Long = 13408767 といった感じで。 (ぶらっと) ---- （ぶらっと）さん、ありがとうございます。 VBA初心者です。 なるほどです。 奥が深いですね。 ありがとうございました。 ---- で、本題の、日付が変わったら、ボタンを押さなくても実行する件。 あぁ、その前に、色番号の指定、Const を継続するなら以下のような記述もあるのでご参考まで。 Const SunColor As Long = 255& + 153& * 256 + 204 * 256 ^ 2 この 255や 153や 204 が R G B それぞれの値。 さて。今まで変更のあったセルのみを対象に処理していたけど、常に一括処理にかえよう。 ThisWorkbookモジュールの Workbook_Open とWorkbook_SheetChange　を入れ替え。 新しく　Private Sub ChangeColor()　を追加。 Private Sub setColor は変更なし。従来通りの形で使用。 （コードは、こちらで持っているものをベースにしている。もし、そちらで手を加えていればそこはそちらで対処お願い） ・基本的には、Workbook_Open のコードの中身を、そっくり、Private Sub ChangeColor()　に引っ越し。 ・これに伴い、Workbook_Open は 元の Private 記述に戻そう。 Private Sub Workbook_Open() ChangeColor End Sub Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal target As Range) Dim r As Range Dim c As Range Dim myColor As Long If Not sh Is Sheets(MYSHNAME) Then Exit Sub If target.Columns.Count = sh.Columns.Count Then Exit Sub ' 行削除、挿入 If target.Rows.Count = sh.Rows.Count Then Exit Sub '列削除、挿入 Set r = Intersect(target, sh.Columns("E:F"), sh.Rows("4:" & sh.Rows.Count)) If r Is Nothing Then Exit Sub 'E,F列の4行目以下のみ ChangeColor End Sub Private Sub ChangeColor() Dim rE As Range, rF As Range, rX As Range Dim z As Long Dim myColor As Long Dim c As Range Dim ok As Boolean Application.EnableEvents = False With Sheets(MYSHNAME) 'いったん色を全てクリア .Cells.Interior.ColorIndex = xlNone '土日色と本日色のセット For Each c In .Range("G1", .Cells(1, .Columns.Count).End(xlToLeft)) myColor = 0 If c.Value = Date Then myColor = dayColor ok = True Else Select Case Weekday(c.Value) Case vbSunday myColor = SunColor Case vbSaturday myColor = satColor End Select End If If myColor Then c.EntireColumn.Interior.Color = myColor Next z = WorksheetFunction.Max(4, _ .Range("E" & .Rows.Count).End(xlUp).Row, _ .Range("F" & .Rows.Count).End(xlUp).Row) 'E,F列の日付入力欄の日付による色を復元 For Each c In .Range("E4:F" & z) If IsDate(c.Value) Then Call setColor(c) Next End With Application.EnableEvents = True If Not ok Then MsgBox "今日の日付が見つかりません。", vbExclamation End Sub ---- （ぶらっと）さん、ご無沙汰しております。 VBA初心者です。 別件で忙しくて、保留にしておりました。 申し訳ありません。 上記をThisWorkbookにコピペして、実行するとコンパイルエラー SubまたはFuncyionが定義されていません。と表示されます。 Private Sub ChangeColor() … If IsDate(c.Value) Then Call setColor(c)　で止まります。 申し訳ありませんが、ご対応お願いします。 ---- もうすっかり忘却の彼方・・・だけど、最後のコードをアップする際に >Private Sub setColor は変更なし。従来通りの形で使用。 こう、コメントしているよね。 つまり、setColor　プロシジャは 以前のまま継続使用するんだけど、ちゃんとモジュールに、そのプロシジャはある？？ (ぶらっと)