[[20160128172440]] 『お知らせを表示したい』(右近) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『お知らせを表示したい』(右近)

以下のような車の走行距離の記録があります。
一定の距離が近づいたら、備考欄に「オイル交換の時期が近づいています!」的な
メッセージを表示させたいのですが、どのような方法がありますか?

  A    B    C   D   E
  日付   開始 終了 距離  備考
1 1/10   99  110  11
2 1/11   110  140  30
3 1/12   140  172  32
4 1/13   172  200  28 ★オイル交換の時期が近づいています!
5 1/14   200  235  35

出来れば、4行以下は赤文字か何かにして強調したいです。
そして、Fセルにオイル交換したことを入力したら、解除されるという形に出来ないでしょうか?

どうぞよろしくお願いします。

< 使用 Excel:Excel2013、使用 OS:Windows7 >


 その「一定の距離」の情報は?
(GobGob) 2016/01/28(木) 17:39

[[20160128123108]] 『修正したセルを分かるようにする』(右近)
 先にこっち片付けてほしいな
(稲葉) 2016/01/28(木) 17:40

 交通整理だけ。

 ・まず、1行目はタイトル行、2行目からデータですか?
 ・走行累計が何キロになったらオイル交換メッセージなんですか?
 ・そのメッセージが出た行が 1/13 日の行だったとします。
  オイル交換済みマークは、その行のF列に入力するんですね。
 ・で、オイル交換済みだとして、今回の累計の開始は、その行からですか?
  でも、その行は結果であって、それを受けてオイル交換するわけですから、累計の開始は、その次の行からですか?
 ・データ入力には間違いはつきものですね。すでに累計計算されて、オイル交換メッセージが出たところまでの走行データを
  修正したとすると自動的に再計算必要ですね?

 ★ 稲葉さんの指摘、激しく同意!!

(β) 2016/01/28(木) 17:50


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim mx As Long, ctr As Long, cl As Range
    If Target.Column <> 4 And Target.Column <> 6 Then Exit Sub
    If Cells(Rows.Count, 6).End(xlUp).Row > Cells(Rows.Count, 4).End(xlUp).Row Then Exit Sub
    mx = 100 '交換後100キロで警告する例
    Rows.Font.ColorIndex = xlAutomatic
    Columns(5).Cells.ClearContents
    For Each cl In Intersect(UsedRange.Columns(6).Cells, Range(Cells(Rows.Count, 6).End(xlUp).Offset(1), Cells(Rows.Count, 6)))
        ctr = ctr + cl.Offset(, -2)
        If ctr > mx Then
            cl.EntireRow.Font.Color = -16776961
            Cells(cl.Row, 5) = "★オイル交換の時期が近づいています!"
        End If
    Next cl
End Sub
(mm) 2016/01/28(木) 18:26

・まず、1行目はタイトル行、2行目からデータですか?
 はい、そのとおりです。

・走行累計が何キロになったらオイル交換メッセージなんですか?
 別シートに基本情報を入力して、自由に変更できるようにしたいのですが・・・

・そのメッセージが出た行が 1/13 日の行だったとします。
 オイル交換済みマークは、その行のF列に入力するんですね。
 はい、そうです。

・で、オイル交換済みだとして、今回の累計の開始は、その行からですか?
 でも、その行は結果であって、それを受けてオイル交換するわけですから、累計の開始は、その次の行からですか?
 はい、F列にオイル交換済みを入力した次の行にしたいです。

・データ入力には間違いはつきものですね。すでに累計計算されて、オイル交換メッセージが出たところまでの走行データを修正したとすると自動的に再計算必要ですね?
 はい、またそこから開始したいです。オイル交換済みを入力した次の行からまた開始したいです。

説明不足で申し訳ありません。
可能なら、お知らせは点滅とかさせたいですが、無理でしょうか。
どうぞよろしくお願いします。

(右近) 2016/01/28(木) 21:47


 練習してみました。

 とりあえず 累計基準値は数式内で固定しています。
 G2 の式内の 100 のところを 基準値が入ったセルに置き換えてください。

 条件付書式の式もあり、変更時のメンテナンスを少なくするため G列を作業列に使っています。
 オイル交換をしたら、メッセージの出た行のF列に、何か数字をいれます。

 2000行目まで対応しています。

 G1 : =IFERROR(LOOKUP(9^9,F1:F2000,ROW(F1:F2000)),2)
 G2: =AND($A2<>"",ROW()>$G$1,SUM(INDEX($D:$D,$G$1):$D2)>=100)

 G2を下にズリズリフィルコピー。

 E2 : =IF(AND(G2,G1<>TRUE),"★オイル交換の時期が近づいています!","")

 E2 をずりずり下にフィルコピー

 A2:D● を選択して条件付書式 数式が =$G2  フォント書式を赤に。
(β) 2016/01/28(木) 21:55

ありがとうございます。
早速やってみてますが・・・
E1にいきなりメッセージが出てしまいます。
私の入れ方がおかしいのでしょうか・・・。
(右近) 2016/01/28(木) 22:21

やってみて気づきましたが、D列の累計では、うまくいきません。
例えば、100キロごとにお知らせとする場合、その行までを累計してくるならわかりますが、
その行のみをみていますよね?
(右近) 2016/01/28(木) 22:40

 >>E1にいきなりメッセージが出てしまいます。 

 ??

 >>E2 : =IF(AND(G2,G1<>TRUE),"★オイル交換の時期が近づいています!","")
 >>E2 をずりずり下にフィルコピー

 と書いたんですが?  E1 には 何も入れてませんよねぇ。

 >>その行のみをみていますよね?

 えっ? 累計してるつもりですが?

(β) 2016/01/28(木) 22:51


 あぁ、それと

 >>可能なら、お知らせは点滅とかさせたいですが、無理でしょうか。

 関数では無理ですねぇ。
 VBAで、ゴシゴシはできないことはないですが、う〜ん。
 やりたいですか?

(β) 2016/01/28(木) 23:44


 点滅に関して学校内に格好の教科書がありましたので、以下にURLをはっておきます。
 これを参考に、やってみられるのも、いいかもしれませんが。

 点滅

[[20090420091851]] 『指定のセルの点滅停止ボタン』(みこ)

 タイマー表示

[[20090513133425]] 『タイマ-を表示させたい』(みこ)

 上記の手法を共存させる手法として

[[20090601090523]] 『点滅とタイマ−の両方のマクロを作動させたい』(みこ)

(β) 2016/01/29(金) 07:22


 !!!

 今、本格的にデータを増やしてやってみましたら、2行目から始まるレイアウトであってもオイル交換後の表示に、おかしなところ(指摘されたところ)がでてきました。

 調べます。(懺悔)

(β) 2016/01/29(金) 07:27


ありがとうございます。
ご返事を楽しみにしております。
点滅等もやれるんですね。
ありがとうこざいます。
(右近) 2016/01/29(金) 07:57

 E2 の式、 オイル補給の1行下からではなく、その行から累計していました。

 =AND($A2<>"",ROW()>$G$1,SUM(INDEX($D:$D,$G$1+1):$D2)>=100)

 これでお試しください。

(β) 2016/01/29(金) 08:03


βさん、ありがとうございます。
ただ、D列は累計ではなく、その区間の走行距離になります。
私がやってみているのでは、うまくいきませんが・・・
(右近) 2016/01/29(金) 08:15

 不思議ですねぇ。
 たとえば最初にアップされたサンプルと同じもの(ただし1行目はタイトル行)で、提示した数式を入れ、条件付書式設定をすると

 G1 : 2
 G2〜G6 が Fasle,False,Fasle,True,True
 E5 にメッセージが表示され
 A5:D6 が赤文字になります。

 F5 に 1 を入れると

 G1 : 5
 G2〜G6 が すべてFasle
 E5 のメッセージが消え
 A5:D6 が黒文字になります。

 それと、

 >>D列は累計ではなく、その区間の走行距離になります。

 コメント済みですが、オイル補給の下から各行の走行距離を数式内で累計して判定しています。

 SUM(INDEX($D:$D,$G$1+1):$D2)>=100 この部分です。

 【累計ではなく走行距離になります】という指摘は、行単独の数字として 100 未満なら
 それがどれだけ続いてもメッセージは出ず、行単独で 100 以上の列にしかメッセージは出ないということですか?

 極端にいえば、D2からD6 まで すべて 99 だったときにはメッセージが出ないということですか?

 そうであれば、実に不思議ですねぇ。

(β) 2016/01/29(金) 08:35


 作業列使うなら、これじゃダメ?
     |[A]    |[B] |[C] |[D] |[E]                               |[F]       |[G]                        
 [1] |日付   |開始|終了|距離|備考                              |交換フラグ|累計                       
 [2] |1月10日|  99| 110|  11|=IF(G2>=100,"★オイル交換時期","")|          |=IF(F2="交換",0,SUM(G1,D2))
 [3] |1月11日| 110| 140|  30|                                  |          |                         41
 [4] |1月12日| 140| 172|  32|                                  |          |                         73
 [5] |1月13日| 172| 200|  28|★オイル交換時期                  |          |                        101
 [6] |1月14日| 200| 235|  35|                                  |交換      |                          0
 [7] |1月15日| 235| 267|  32|                                  |          |                         32
 [8] |1月16日| 267| 291|  24|                                  |交換      |                          0
 [9] |1月17日| 291| 325|  34|                                  |          |                         34
 [10]|1月18日| 325| 349|  24|                                  |          |                         58
 [11]|1月19日| 349| 376|  27|                                  |          |                         85
 [12]|1月20日| 376| 409|  33|★オイル交換時期                  |          |                        118
 [13]|1月21日| 409| 432|  23|★オイル交換時期                  |          |                        141
 [14]|1月22日| 432| 454|  22|                                  |交換      |                          0
 [15]|1月23日| 454| 491|  37|                                  |          |                         37
 [16]|1月24日| 491| 514|  23|                                  |          |                         60
 [17]|1月25日| 514| 551|  37|                                  |          |                         97
 [18]|1月26日| 551| 584|  33|                                  |交換      |                          0
 [19]|1月27日| 584| 609|  25|                                  |          |                         25
 [20]|1月28日| 609| 629|  20|                                  |          |                         45
 [21]|1月29日| 629| 653|  24|                                  |          |                         69
 [22]|1月30日| 653| 682|  29|                                  |          |                         98
 [23]|1月31日| 682| 706|  24|★オイル交換時期                  |          |                        122
 [24]|2月1日 | 706| 744|  38|                                  |交換      |                          0

 条件付き書式
 =$E1="★オイル交換時期"
(稲葉) 2016/01/29(金) 08:46

 稲葉さんからすっきりした回答がでていますが、それとは別に。
 (私の解釈と少し違う部分もありますが)

 新規ブックの標準モジュールに以下のコードを貼り付けて Test を実行してください。
 そちらが提示したサンプルに、当方が提示した数式と条件付書式を埋め込んだシートを作り上げます。
 こちらの提示した手順でやっていただければ、このシートと同じものになっているはずなんですが?

 Sub Test()
    Cells.Clear
    Cells.FormatConditions.Delete

    Range("A1:D1").Value = Array("日付", "開始", "終了", "距離", "備考")
    Columns("E").ColumnWidth = 50
    Range("A2:A6").Value = WorksheetFunction.Transpose(Array("1/10", "1/1", "1/12", "1/13", "1/14"))
    Range("B2:D2").Value = Array(99, 110, 11)
    Range("B3:D3").Value = Array(110, 140, 30)
    Range("B4:D4").Value = Array(140, 172, 32)
    Range("B5:D5").Value = Array(172, 200, 28)
    Range("B6:D6").Value = Array(2009, 235, 35)

    Range("G1").Formula = "=IFERROR(LOOKUP(9^9,F1:F2000,ROW(F1:F2000)),2)"
    Range("G2:G2000").Formula = "=AND($A2<>"""",ROW()>$G$1,SUM(INDEX($D:$D,$G$1):$D2)>=100)"
    Range("E2:E2000").Formula = "=IF(AND(G2,G1<>TRUE),""★オイル交換の時期が近づいています!"","""")"

    With Range("A2:D2000")
        .FormatConditions.Add Type:=xlExpression, Formula1:="=$G2"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Font
            .Color = vbRed
            .TintAndShade = 0
        End With
        .FormatConditions(1).StopIfTrue = False
    End With

 End Sub

(β) 2016/01/29(金) 09:09


マクロで点滅まで実現する例。
シートにActiveXのボタンを1つ貼っておいてください。
ボタンを押すかC列(終了値)またはF列(交換フラグ)を入力すると動作します。
(交換時期に達していなければ、なにも起こりませんが)

 【シートモジュール】
 Private Sub CommandButton1_Click()
    Const IMAX = 100
    Dim i As Long
    Dim iAll As Long
    Dim iSt As Long
    Dim iEd As Long

    ip = 0
    Cells.Interior.Color = xlNone
    iSt = Cells(Rows.Count, "F").End(xlUp).Row
    iEd = Cells(Rows.Count, "C").End(xlUp).Row

    For i = iSt To iEd
        iAll = iAll + Cells(i, "D").Value
        If IMAX <= iAll Then
            If ip = 0 Then
                ip = i
                Cells(i, "E").Value = "★オイル交換時期"
                Exit For
            End If
        End If
    Next i

    If ip = 0 Then
        If 0 < dNext Then
            Application.OnTime dNext, "sFlash", , False
            dNext = 0
        End If
    Else
        If dNext = 0 Then
            Call sFlash
        End If
    End If
 End Sub

 Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("C:C,F:F")) Is Nothing Then
        Call CommandButton1_Click
    End If
 End Sub

 【標準モジュール】
 Public ip As Long
 Public dNext As Date

 Public Sub sFlash()
    Const ICOLOR = &HFFFF&
    Dim iEd As Long

    If 0 < ip Then
        With ActiveSheet
            iEd = .Cells(.Rows.Count, "C").End(xlUp).Row
            If .Cells(ip, "A").Interior.Color = &HFFFFFF Then
                .Range(.Cells(ip, "A"), .Cells(iEd, "F")).Interior.Color = ICOLOR
            Else
                .Range(.Cells(ip, "A"), .Cells(iEd, "F")).Interior.Color = xlNone
            End If
        End With
    End If

    dNext = Now + TimeValue("00:00:01")
    Application.OnTime dNext, "sFlash"
End Sub

警告されても交換せず、次回持ち越しすることもあるだろうから、交換した日も含めた、最新の距離累計で判定しています。
(交換してから走るのか、帰ってきてから交換するのか…?)
しかし、点滅するにはロジックが複雑になるし、見た目うるさいと思うので、お薦めではないのですよ…。
(???) 2016/01/29(金) 10:46


返事が遅くなってしまい、申し訳ありません。
こちらは打ち切らせてください。
皆さんからご教示頂いたことに感謝いたします。
ありがとうございました。
(右近) 2016/02/10(水) 08:20

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.