[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『お知らせを表示したい』(右近)
以下のような車の走行距離の記録があります。
一定の距離が近づいたら、備考欄に「オイル交換の時期が近づいています!」的な
メッセージを表示させたいのですが、どのような方法がありますか?
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
先にこっち片付けてほしいな (稲葉) 2016/01/28(木) 17:40
交通整理だけ。
・まず、1行目はタイトル行、2行目からデータですか? ・走行累計が何キロになったらオイル交換メッセージなんですか? ・そのメッセージが出た行が 1/13 日の行だったとします。 オイル交換済みマークは、その行のF列に入力するんですね。 ・で、オイル交換済みだとして、今回の累計の開始は、その行からですか? でも、その行は結果であって、それを受けてオイル交換するわけですから、累計の開始は、その次の行からですか? ・データ入力には間違いはつきものですね。すでに累計計算されて、オイル交換メッセージが出たところまでの走行データを 修正したとすると自動的に再計算必要ですね?
★ 稲葉さんの指摘、激しく同意!!
(β) 2016/01/28(木) 17:50
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/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にいきなりメッセージが出てしまいます。
??
>>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
E2 の式、 オイル補給の1行下からではなく、その行から累計していました。
=AND($A2<>"",ROW()>$G$1,SUM(INDEX($D:$D,$G$1+1):$D2)>=100)
これでお試しください。
(β) 2016/01/29(金) 08:03
不思議ですねぇ。 たとえば最初にアップされたサンプルと同じもの(ただし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
【シートモジュール】 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
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.