VBAで特定条件時にセルのフォントカラーを変えるコードについて

このQ&Aのポイント
  • VBAで特定条件を満たした場合にセルのフォントカラーを変えるコードを作成していますが、土曜日と日曜日を含まずに特定の日数以降の時間にフォントカラーを変える方法を知りたいです。
  • 質問文の中で紹介されたVBAコードは、セルD3に表示された日付に対して、5日後の10時以降になった場合にセルD7のフォントカラーを変えるものです。しかし、このコードでは土曜日と日曜日も日数に含まれてしまいます。そこで、土曜日と日曜日を除外し、特定の日数以降の10時以降にフォントカラーを変える方法を知りたいです。
  • 質問者はVBAで日付を操作して特定の日数以降の10時以降になった場合にセルのフォントカラーを変えるコードを作成しています。しかし、このコードでは土曜日と日曜日も日数に含まれるため、正確な条件を設定することができません。そこで、土曜日と日曜日を除外し、特定の日数以降の10時以降にフォントカラーを変える方法を教えて欲しいとのことです。
回答を見る
  • ベストアンサー

VBA 表示する日付について質問します。

 セル D3に表示された日付に対してD7に表示の日付が 5日後10時以降になるとフォントカラーを変えるコードを作成しました。 そのコードが下記になります。  Dim TextBox1 As Date TextBox1 = Range("D3") + DateDiff("d", TextBox1, 5) + TimeValue("10:00:00") If Not TextBox1 > Range("D7 ") = True Then Range("D7").Font.Color = vbCyan Else Range("D7").Font.Color = vbBlack End If ここで質問なんですが、上記のコードですと、 土曜日と日曜日も含めて日数を数えてしまいます。 そこで土曜日と日曜日を含まず5日の10時以降になったら フォントカラーを変更したいのですが、どの様にしたら できますでしょうか? 例えば・・・ D3=2014/06/27ならば5日以降~で D7=2014/07/03 10:00:00でvbCyanにフォントカラー変更 祝日はカウントし土・日だけカウントをしない様にしたいです。 お手数ですが宜しくお願いします。

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

  • ベストアンサー
  • mt2008
  • ベストアンサー率52% (885/1701)
回答No.1

土日を除いた日付はワークシート関数のNetworkDaysを使います。 こんな感じでどうでしょう。 Sub Sample()   nRtn = Application.WorksheetFunction.NetworkDays(Range("D3"), Range("D7"))   Range("D7").Font.Color = vbBlack   If (nRtn = 5) * (Hour(Range("D7")) >= 10) Then     Range("D7").Font.Color = vbCyan   End If End Sub

awmori
質問者

お礼

色々試してみましたが、 D7=2014/07/03 10:00:00以降~の日付が変わっても、 そのままフォントカラーがvbCyanにはなりませんでした。 もし宜しければ、どの様にしたら良いか教えて下さい、 お手数お掛けします。

awmori
質問者

補足

回答ありがとうございます。 D3=2014/06/27の日付表示で D7=2014/07/03 10:00:00でフォントカラーが変更になるんですが、 D7=2014/07/04 10:00:00ではvbBlackに戻ってしまいます。 D7=2014/07/03 10:00:00以降~日付が変わっても vbCyanのままでお願いできますでしょうか?

関連するQ&A

  • VBAのTextBox表示について質問します。

    実は、MicrosoftのExcel内にありますVBAを使ってシート内に記載られている内容を Userform内にあるTextBoxに表示させたいと考えています。 UserformにあるTextBoxは、シートのセルに対してTextBoxを1個配置させています。 例えば・・・セルA1に入力されている文字をTextBox1に表示 セルB1に入力されている文字をTextBox2に表示 セルC1に入力されている文字をTextBox3に表示 セルD1に入力されている文字をTextBox4に表示 セルE1に入力されている文字をTextBox5に表示と言う様な感じで表示したいです。 セル表示範囲は、A1~E24までのセルでTextBoxもTextBox24まで存在します。 TextBox1.Text = ThisWorkbook.Sheets("Sheet1").Range("A1") TextBox2.Text = ThisWorkbook.Sheets("Sheet1").Range("B1") TextBox3.Text = ThisWorkbook.Sheets("Sheet1").Range("C1") TextBox4.Text = ThisWorkbook.Sheets("Sheet1").Range("D1") TextBox5.Text = ThisWorkbook.Sheets("Sheet1").Range("E1") TextBox6.Text = ThisWorkbook.Sheets("Sheet1").Range("A2") TextBox7.Text = ThisWorkbook.Sheets("Sheet1").Range("B2") TextBox8.Text = ThisWorkbook.Sheets("Sheet1").Range("C2") TextBox9.Text = ThisWorkbook.Sheets("Sheet1").Range("D2") TextBox10.Text = ThisWorkbook.Sheets("Sheet1").Range("E2") 以降~途中省略 TextBox120.Text = ThisWorkbook.Sheets("Sheet1").Range("E24") と言う様な・・・ 上記の、この様なコードでして行くと事は可能なんですが・・・ もっと短く出来ないでしょうか?

  • VBA 得意先ごと且つ日付ごとに数値を集計したい

    あるエクセルシートを自動処理するVBAを作成しようとしています。 シートの内容は A日付列 B得意先コード列 C金額列 20091001 000001 \1,000 20091001 000001 \1,500 20091002 000002 \800 20091002 000001 \1,200 といった感じです。 これを、指定した日付で、且つ得意先コード毎に集計したいと考えています。(上記の例だと、コード000001得意先は20091001で\2,500、20091002で\1,200といった具合です) 現在、日付毎で集計するところまでは作成できたのですが、ここから得意先別で集計するにはどのようにコーディングすればよいでしょうか。 日付毎の集計は以下のようにしています。 cnt = 2 Total = 0 Do Until False '行が底に達したらループを終了します If Range("D" & cnt).Value = "" Then Exit Do End If     'D列の日付と指定の日付が合致したら If yearmonthday = Range("D" & cnt).Value Then 'L列の金額を取得しカウント Total = Total + CDbl(Range("T" & cnt)) '次の行を検索するための行数カウント cnt = cnt + 1 Else cnt = cnt + 1 End If Loop ご存知の方、どうぞ教えてください。

  • VBA publicで日付が呼び出せない

    VBAにて、ユーザーフォーム上のテキストボックスに初期値として今日の日付が入力されており、さらにそれを任意で変更することも出来、最終的なテキストボックスの値を変数に格納するというマクロを作成しようとしています。 'テキストボックス2の初期値を今日の日付とする Private Sub UserForm_Initialize() TextBox2.Text = Format$(Date, "yyyy/mm/dd") 'テキストボックス2の値が日付かどうかチェック Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If IsDate(TextBox2.Value) Then DenpyouDate = TextBox2.Value Else TextBox2.Value = "" MsgBox ("日付が不正です") TextBox2.Text = Format$(Date, "yyyy/mm/dd") End If End Sub '他のモジュールでdenpyoudateを使用し、指定のセルに和暦形式で入力する Public DenpyouDate As Date Sheets("伝票").Range("A10").Value = Format(DenpyouDate, "e") Sheets("伝票").Range("C10").Value = Format(DenpyouDate, "m") 「ユーザーフォームのテキストボックスに初期値として日付を表示させ、その最終的な値を変数として格納、別のモジュールで呼び出してセルにセットする」というイメージです。 このマクロを実行した際、初期値である今日の日付を任意の日付に変更した場合は、問題なくそのままの値がセルにセットされるのですが、初期値のまま実行すると、その数値が反映されません。 ローカルウィンドウをチェックすると、ユーザーフォームの時点では、テキストボックスの初期値がきちんとdenpyoudateに格納されているのですが(例:2009/11/24)、それを別モジュールで呼び出した時は、denpyoudateの値が(#0:00:00#)になっており、これが原因だと考えています。 このエラーを回避し、初期値の場合でも値がきちんとセルにセットされるようにするには、どうしたらよいでしょうか?

  • 日付の表示について

    im myDate As Date myDate = TextBox1.Text Sheet1.Range("B1").Value = myDate Sheet1.Range("B1").NumberFormatLocal = "m" *********************************************** 上のようにTextBoxで入力された日付で、 1日≦myDate>25日の場合は(例:12/10)⇒ セルB1には「12月」と表示 25日≦myDate≧31日の場合は(例:12/25)⇒ セルB1には「1月」と表示 させたいのですが、どのようにしたらよいのでしょうか。

  • excel vba ジャンプ

    excel2003のUserFormにてtextbox作成しました。 textbox1にページを入力すると指定のページにジャンプする コードを作成したのですが、動作的には目的とする事ができました。 ただ、初心者レベルで作成したので、コード記述が長く、 ページが増えるたびにコードを追記していかなければなりません。 下記に作成したコードを記述します。 もっと簡単に記述する方法はありますか? ---------------------------------------------------------- Private Sub TextBox1_Change() If TextBox1.Value = 1 Then ActiveWindow.ScrollRow = 1 ActiveWindow.ScrollColumn = 1 Range("$A$15").Select End If If TextBox1.Value = 2 Then ActiveWindow.ScrollRow = 38 ActiveWindow.ScrollColumn = 1 Range("$A$38").Select End If If TextBox1.Value = 3 Then ActiveWindow.ScrollRow = 69 ActiveWindow.ScrollColumn = 1 Range("$A$69").Select End If If TextBox1.Value = 4 Then ActiveWindow.ScrollRow = 100 ActiveWindow.ScrollColumn = 1 Range("$A$100").Select End If If TextBox1.Value = 5 Then ActiveWindow.ScrollRow = 131 ActiveWindow.ScrollColumn = 1 Range("$A$131").Select End If End Sub ---------------------------------------------------------- 上記記述で行っていることは、 textbox1に 1 と入力すると1ページ目が表示  キーボードでctrl+Homeの操作をした状態でカーソルがA15選択 textbox1に 2 と入力すると2ページ目が表示  表示の先頭が38行目、カーソルがA38選択 ページの行数が1ページ目だけ37行 2ページ目以降が31行ごとです。 実際は、200ページ以上あるのでなんとかしたいのですが・・・・

  • EXCEL VBA 日別データを検索しコピー

    度々すいません。行き詰まりましたので教えてください。 エクセルSheet2に月の日別のデータがあります。日によってデータの 行数はまちまちですが、A列には日付、B,C,D列には時間、E列には目的等々があります。そのデータをユーザーフォームのスピンボタンで日付を指定し、コマンドボタンをクリックしたら、Sheet1の1日分の表にコピーしたいのです。また指定日がなければメッセージで指定日がありませんと表示したいのです。よろしくお願いします。 excel2003 Private Sub SpinButton1_Change() TextBox1.Value = Date + SpinButton1.Value End Sub Private Sub CommandButton1_Click() '年月日表示 Range("C3") = Format(TextBox1.Value, "yy") Range("D3") = Format(TextBox1.Value, "mm") Range("E3") = Format(TextBox1.Value, "dd") Range("F3") = Format(TextBox1.Value, "aaa")   ここがわかりません   Else MsgBox "指定日がありません" End If End Sub

  • vba 曜日のデータ

    どなたか教えて頂ければ幸いです。 以下のようなコードがあります。これは、1~31迄の日付シートに あらかじめ用意されている日~土までの曜日シートの内容を 自動的にコピーしようとしているものです。 日付シートのB5には weekday()関数とユーザー定義の書式のaaaにより 日曜日なら「日」、月曜日なら「月」が入っています。 ですが、下の「<------」の箇所は、エラーではありませんが、 一致確認がなされていません。weekday()関数の戻り値を文字列と して見ていないのでしょうか? Sub test() Dim ws As Worksheet Dim i As Integer For Each ws In Worksheets  For i = 1 To 31   If ws.Name = CStr(i) Then   ws.Select    If ws.Range("B5") = "日" Then      <-----     Worksheets("日").Range("A1:D3") _       .Copy Destination:=ws.Range("A7")       ws.Tab.ColorIndex = 45    ElseIf ws.Range("B5") = "月" Then    <-----     Worksheets("月").Range("A1:D3") _     .Copy Destination:=ws.Range("A7")     ws.Tab.ColorIndex = xlNone

  • エクセル2010、VBAや関数について

    Private Sub CommandButton1_Click() Worksheets("商品マスタ").Activate Application.Calculation = xlCalculationManual If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData ActiveWindow.ScrollRow = 3 Range("AI1:AQ4").ClearContents Range("AI1:AQ4").NumberFormatLocal = "@" Range("AJ2:AK2").Value = Range("B2:C2").Value Range("AL2:AM2").Value = Range("D2").Value Range("AO2").Value = Range("E2").Value Range("AP2").Value = Range("V2").Value Range("AQ2").Value = Range("W2").Value Range("AN2").Value = Range("D2").Value If Me.TextBox1.Value <> "" Then ' コード Range("AK3").Value = "*" & Me.TextBox1.Value End If If Me.TextBox2.Value <> "" Then ' メーカー Range("AL3").Value = "*" & Me.TextBox2.Value & "*" End If If Me.TextBox3.Value <> "" Then ' <--シリーズ Range("AM3").Value = "*" & Me.TextBox3.Value & "*" End If If Me.TextBox4.Value <> "" Then ' <--サイズ Range("AN3").Value = "*" & Me.TextBox4.Value & "*" End If If Me.TextBox5.Value <> "" Then ' 入荷日 Range("AJ3").Value = Me.TextBox5.Value End If If Me.TextBox9.Value <> "" Then ' 仕入れ先 Range("AP3").Value = Me.TextBox9.Value End If If Me.TextBox12.Value <> "" Then ' 単体価格 Range("AQ3").Value = Me.TextBox12.Value End If If Me.TextBox6.Value <> "" Then ' 在庫数 Range("AO3").Value = Me.TextBox6.Value End If If Cells(3, Columns.Count).End(xlToLeft).Column > 34 Then Range("A2:W" & Rows.Count).AdvancedFilter Action:=xlFilterInPlace, _ CriteriaRange:=Range("AI2").CurrentRegion, Unique:=False End If Range("AI1:AQ4").ClearContents ActiveWindow.ScrollColumn = 4 Range("A2").Activate Application.Calculation = xlCalculationAutomatic End Sub このようなマクロを組んでいるのですが、とても反応が遅いのですが、 シートにはA4-AG2000にデータが入っていて、 G4-U2000には =SUMIFS('[在庫.xlsx]02'!$AD:$AD,'[在庫.xlsx]02'!$AQ:$AQ,$A421,'[在庫.xlsx]02'!$AS:$AS,$F$2,'[在庫.xlsx]02'!$AT:$AT,G$2) このような関数が入っております。 これが原因で、動作が遅くなっているのでしょうか? 行の挿入等もとても遅いのですが、 G-U列の関数をやめてVBAで転記してから、検索をかけたら、早くなるのでしょうか? G-U列には関数での表記しかわからなかったため、関数をいれております。 解決法があれば教えてください。

  • VBAで複数検索、AdvancedFilter

    AdvancedFilterを使って、検索を行っているのですが、応答なしと固まってしまったり、動作が重くなったりするのですが、原因わかりますでしょうか? 3000行くらいなのですが、ユーザーフォームを立ち上げて、検索、結果を見て、また検索をしようとすると固まったりして動かなくなって強制終了になる場合があります。 軽くなる方法はありますか? Private Sub CommandButton1_Click() Worksheets("商品マスタ").Activate If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData ActiveWindow.ScrollRow = 3 Range("S1:AA4").ClearContents Range("S1:AA4").NumberFormatLocal = "@" Range("T2:U2").Value = Range("B2:C2").Value Range("V2:X2").Value = Range("D2").Value Range("Y2:Z2").Value = Range("E2:F2").Value Range("AA2").Value = Range("G2").Value If Me.TextBox1.Value <> "" Then ' コード Range("U3").Value = "*" & Me.TextBox1.Value End If If Me.TextBox2.Value <> "" Then ' メーカー Range("V3").Value = "*" & Me.TextBox2.Value & "*" End If If Me.TextBox3.Value <> "" Then ' シリーズ Range("W3").Value = "*" & Me.TextBox3.Value & "*" End If If Me.TextBox4.Value <> "" Then ' サイズ Range("W3").Value = "*" & Me.TextBox4.Value & "*" End If If Me.TextBox5.Value <> "" Then ' 入荷日 Range("T3").Value = Me.TextBox5.Value End If If Me.TextBox9.Value <> "" Then ' 仕入れ先 Range("Z3").Value = Me.TextBox9.Value End If If Me.TextBox12.Value <> "" Then ' 単体価格 Range("AA3").Value = Me.TextBox12.Value End If If Me.TextBox6.Value <> "" Then ' 在庫数 Range("Y3").Value = Me.TextBox6.Value End If If Cells(3, Columns.Count).End(xlToLeft).Column > 19 Then Range("A2:G" & Rows.Count).AdvancedFilter Action:=xlFilterInPlace, _ CriteriaRange:=Range("S2").CurrentRegion, Unique:=False End If Range("S1:AA4").ClearContents ActiveWindow.ScrollColumn = 4 Range("A2").Activate End Sub Private Sub CommandButton2_Click() Unload Me End Sub

  • 翌日の日付表示で土日を抜きたい

    質問させていただきます。 次回の会合部屋の予約可能日付を表示させるスクリプトを考えています。まず1日後の日付表示を考えているのですが、1日後が土曜日或いは日曜日の際には翌週の月曜日が表示されるようにしたいです。 現状は下記のとおり1日後の日付を表示する事しかできません。 <? $youbi = array("日","月","火","水","木","金","土"); $d=mktime(0,0,0,date("m"),date("d")+1,date("y")); print date("Y年m月d日",$d)." (".$youbi[date("w",$d)].")"; ?> 土曜日と日曜日は表示から省かれるようにする方法を教えてください。

    • ベストアンサー
    • PHP

専門家に質問してみよう