質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

91.01%

  • VBA

    1415questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

VBA セルの色を変更し、セルの色の戻し方(動作を元に戻す)

解決済

回答 6

投稿 編集

  • 評価
  • クリップ 1
  • VIEW 917

HISUI

score 11

今、社内ツールの改修を行っていて、契約終了日が近づいた契約名のセルの背景の色が変わるようなプログラムを作成し、その後色が変わったセルの色を元に戻したいと考えています。
ちなみに契約終了日が近づいた契約名のセルの背景の色が変わる動作までは出来ています。
どのサイトでも実行したものを元に戻せないと書いてあり、改修を依頼してきた上司も新しいボタンを作成して登録するしかないと言っており、困っています。

新しいボタンで登録できるのならその方法を、既存のプログラム中に組み込めるならその方法を教えて頂きたいと思います。

使っている物です。
Windows2010
Excel2013

’Sub 契約終了日確認()
' 契約終了日確認 Macro

'行いたい事:今日から契約終了年月日まで60日を切っている契約名を表示させる。

'①:msgboxで今日の日付を返す。

'②:契約終了日から今日の日付を引く。

'③:60日を切っていたらその契約名をmsgboxに載せる。

Dim ws As Worksheet
Dim fname As String

Dim 既存ファイル名 As String
Dim 保存ファイル名 As String

Dim 契約終了日 As Long
Dim 終了日まで As Long
Dim 確認 As Variant

Dim 契約名 As String '契約終了日が60日を切っている契約名を載せる

Dim ah As Range
Dim aj As Range
Dim al As Range

Worksheets("使うシート名").Select

Dim enddate As Date
Dim i As Integer

For i = 6 To 65

enddate = DateSerial(Range("AH" & Format(i)), Range("AJ" & Format(i)), Range("AL" & Format(i)))

'MsgBox Date
MsgBox enddate  'ここで契約終了日から今日の日付を引いて60日未満の契約名を載せたい。

'MsgBox todaydate - Date

If (enddate - Date) < 60 Then
Range("O" & Format(i)).Interior.Color = RGB(200, 200, 200)
End If
Next

End Sub’

VBAは勉強を始めてからあまり日が経っていません。
皆様のお力をお借りしたいと思っています。
よろしくお願い致します。

|N列                    |O列   |P列|
|会社メールアドレス|契約名|契約分野|
|                 |色、表示無し|色、表示無し|
| |色付き|色無し、13158600
| |色無し|色無し、表示無し|
| |色付き|色無し、13158600|
ここから下は
| |色付き|色無し、13158600|の表示になります。

’Sub 契約終了日確認()
'契約終了日確認 Macro
'行いたい事:今日から契約終了年月日まで60日を切っている契約名を表示させる。
'①:msgboxで今日の日付を返す。
'②:契約終了日から今日の日付を引く。
'③:60日を切っていたらその契約名をmsgboxに載せる。
Dim ws As Worksheet
Dim fname As String
Dim 既存ファイル名 As String
Dim 保存ファイル名 As String

Dim 契約終了日 As Long
Dim 終了日まで As Long
Dim 確認 As Variant
Dim 契約名 As String '契約終了日が60日を切っている契約名を載せる
Dim ah As Range
Dim aj As Range
Dim al As Range
Worksheets("シート名").Select
Dim enddate As Date
Dim i As Integer
For i = 6 To 65
enddate = DateSerial(Range("AH" & Format(i)), Range("AJ" & Format(i)), Range("AL" & Format(i)))
MsgBox enddate 'ここで契約終了日から今日の日付を引いて60日未満の契約名を載せたい。
'MsgBox todaydate - Date
If (enddate - Date) < 60 Then
Range("P" & Format(i)).Value = Range("O" & Format(i)).Interior.Color '元の色を隣(P列)のセルに保存。
Range("O" & Format(i)).Interior.Color = RGB(200, 200, 200) 'セルに色を付ける
End If
Next
Dim rowNo As Integer '色を変えるセルの行番号を入れる変数
Range("O" & rowNo).Interior.Color = Range("P" & rowNo).Value 'セルに色を付ける
End Sub’

コードも掲載しておきます。

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 6

+1

下記のように変更すれば良いとうことでしょうか?
それとも違うことをやりたいのでしょうか?
※既存のプログラムを理解していれば容易に到達できる気がしますが。

If (enddate - Date) < 60 Then
    Range("O" & Format(i)).Interior.Color = RGB(200, 200, 200)
Else
    Range("O" & Format(i)).Interior.Color = RGB(元の色)
End If

'色なしならこっちかな
    Range("O" & Format(i)).Interior.ColorIndex = xlNone

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2017/09/05 16:14

    早速のご回答ありがとうございます。
    もしかしたら、私の質問の聞き方が悪かったみたいですね。
    要は動作をさせた後に動作前の状態にさせたいのです。
    色が変わった部分はこれから先もそのままにするわけではないので現状、セルの背景色を自分達で手操作で直している状態なのを改修したいのです。
    分かりにくくてすいません。

    キャンセル

checkベストアンサー

0

つまりこういうことでしょうか。
①チェック用のボタンを押した時、契約終了まで60日以内の行に色を付けたい。
②でも色付けは一時的なもので、どれが契約終了間近なのか確認がすんだらまた元の色に戻したい。

この場合、①だけなら条件付き書式で色を付ければよさそうですが、②に関しては単純ではなさそうです。


シート上にデータを書き込んでいいのなら、coco_bauerさんのアドバイスのとおり、ほかの列に色情報を残せばいいと思います。
シート上に一般人にはわけのわからない情報が載ることになりますが、列を非表示にするなど工夫すれば見栄えも損なわないでしょう。

シート上には載せたくない(シート内容は変更したくない)という場合には、VBA上で共通変数などに配列として格納して覚えておくという方法もあります。
ただし、メモリ上にしか記憶していないデータになりますので、色を元に戻す前にExcelを閉じてしまうともう元の色は覚えていない、ということにもなります。

以下は共通変数に記憶するサンプルです。

Private aryColor() as Double    '色を覚えておく配列

Sub 色付け関数()

    '(省略)

    For i = 6 To 65
        Redim Preserve aryColor(i)  '配列の要素数を拡張
        aryColor(i) = Cells(i, "O").Interior.Color  '変更前の色を格納

        '判定やら色付けやらの処理
        '(省略)
    Next
End Sub

Sub 色戻し関数()
    For i = 6 To 65
        'セルの色を配列に格納しておいた色に戻す
        Cells(i, "O").Interior.Color = aryColor(i)
    Next
End Sub

別案として、これまでの色情報を残すという切り口とは異なる提案になりますが、確認用の列を1列設けてみてはどうでしょうか。

①確認用の列(仮にP列)を設ける
②O列のセルには条件付き書式で確認用の列が1の場合に色を付ける設定をしておく。
(例:O6セルの条件付き書式として=(P6=1)の場合に色付けを設定する)

③チェックボタン押下時の処理では、判定結果で色を変えるかわりに、確認用の列にチェック結果(警告が必要な場合1、不要な場合は空)をセットする
④色を消したい場合は確認用の列のセルの値をクリアする

上記のような流れで、色を付ける・戻すが実現できそうです。
(「条件付き書式」は条件を満たした場合には条件で指定した書式、満たさない場合にはセル自体に設定されている書式で表示してくれます。)
また色付けによる確認だけでなく、オートフィルタで判定結果を絞り込んだりもできるので扱いやすくなると思います。

シートのデザインにも影響を与えてしまうので賛否あるかもしれませんが、一つの案としてご紹介しました。

参考になれば幸いです。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2017/09/11 11:19

    ありがとうございました。
    jawaさんが回答して下さった内容で出来ました。
    上司の方からもokが下りて一安心しました。
    今回の社内ツールは一から自分一人で作ったので無事に完成できてよかったです。
    他にも回答して下さった皆様、本当にありがとうございました。
    また、質問する機会があればよろしくお願いします。

    キャンセル

0

元の色に戻すには、元の色を記録しておく必要があります。
元の色が判らないのであれば、元の色に戻すことはできません。

O列のセルに色を付けているようですから、P列を元の色の値を保存するために使うことにすると

If (enddate - Date) < 60 Then
Range("P" & Format(i)).value = Range("O" & Format(i)).Interior.Color '元の色を隣(P列)のセルに保存。
Range("O" & Format(i)).Interior.Color = RGB(200, 200, 200) 'セルに色を付ける
End If


そして、元の色に戻すときには

Dim rowNo as Integer '色を変えるセルの行番号を入れる変数
Range("O" & rowNo).Interior.Color = Range("P" & rowNo).value 'セルに色を付ける


という感じになります。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2017/09/05 17:37

    早速のご回答ありがとうございます。
    試してみたのですが、P列に’13158600’と一行だけ表示が出るとその直ぐ下の一行だけ飛ばされ、残りは’16777215’と最後の行まで表示されます。
    O列の方は’13158600’の部分と’16777215’の部分全て色が戻りませんでした。
    やはり、別で登録して作った方がよいのでしょうか。
    何度も申し訳ございません。

    キャンセル

  • 2017/09/06 16:56

    試してみたコードと、実行前と実行後のワークシートの図(セルの色の変化が判るもの)を質問に追加してもらえませんか。ちょっと状況が判らないので。

    キャンセル

0

色の変更を条件付き書式にしておけば、その条件付き書式で参照している値が変化すれば、色も変化します。

前の質問(VBAで日付の検索して表示させる)で、回答者の皆さんも元に戻す(状態によって変化する)ケースを見越して、条件付き書式を薦めていたと思いますよ。

VBAのコードもマクロの記録を使えば、ベースにはなるでしょうし。

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

0

せっかく色付けまで出来ているので、それを使うとすると…
1.色を付けたいシートのコピーを作成
2.コピーしたシートに色を付けて、アクティブにする。
3.終了する時は元のシートをアクティブにし、コピーを削除する。

では如何でしょう?

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

0

隠し(非表示シート)を1枚作って、操作シートと同じ位置のセルに書式を保存するのはどうでしょうか?。これだと、保存、復元は書式のコピーだけで済みますし、背景以外の書式にも対応できます。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 91.01%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

  • 解決済

    【ファイル名の読み込み】

    23歳OLです。 会社でマクロを組むことになりましたが、 初心者過ぎて全然よくわかりません。 お忙しいところ大変恐縮ですが、教えていただけないでしょうか。 ※やりたいことがわか

  • 解決済

    【VBA】任意の文字選択

    ボールドテキストいつもお世話になってます。 23歳OLです。ついに社会人2年目になりました! 本日の悩みなのですが、 ▼やりたいこと ・TODAY関数で表示した、今日の日付のと

  • 解決済

    印刷ジョブのキューに一部のファイルしか登録されない

    「コントロールパネル」>「デバイスとプリンター」 「iR-ADV C5045」を右クリック>「印刷ジョブの表示」 で表示される印刷ジョブウインドウに 67個のExcelファイルを

  • 受付中

    VBAの効率化

    VBAの効率化(というより基本的な書き方?)についての質問です。 以前作成したコードを再度流用することとなり、知識0の状態で作っていた酷い有様のコードを ちょっとはマシな形にしよう

  • 解決済

    つExcel.マクロ.VBお助けください。

    エクセルでマクロを組んでいます   別ファイルの指定した個所の値を取り込みたいです。 途中までは動いているのですが指定した個所の値ではなく、 なぜか空白になってしまってい

  • 解決済

    【マクロ】グラフのX系列の値を指定したいのにできません。

    グラフのX系列の値をRange("T1014:T3014")を指定したいのですが、何故かX系列の値がRange("N1014:N3014")になってしまいます。 cht.Seri

  • 解決済

    VBA 実行時エラー ’1004’ アプリケーション定義またはオブジェクト定義のエラーです

    前提・実現したいこと ここに質問したいことを詳細に書いてください VBAでタスクをガントチャートに表示して管理するアプリを作っています。 「タスク1つにつきエクセル方眼紙3マ

  • 解決済

    月別かつクライアント別かつ納品日別に請求書を作りたい excel VBA

    閲覧くださいまして、ありがとうございます。 よろしくお願いします。 現在、サイトを参考にexcelで請求書を発行するマクロを組んでおります。 月別かつクライアント別かつ納

同じタグがついた質問を見る

  • VBA

    1415questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。