[[20200525093228]] 『機械稼働ガントチャートの作成』(高梨) ページの最後に飛ぶ

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

 

『機械稼働ガントチャートの作成』(高梨)

現在、仕事で1日の機械の稼働状況を視覚化出来る様にガントチャートを作成しています。
始業開始8:30:00から翌日8:29:00を1日として、以下の様な関数を用いています。

=AND(VALUE(F$2)>=VALUE($A$3),VALUE(F$2)<VALUE($A$4))=TRUE

A3に機械スタートさせた時刻を入力させ、A4に機械をストップした時刻が入力されます。
F2には始業時間8:30:00が入力してあり、E2以降の2の行には、8:31:00、8:32:00といった具合に1分経過ごとの時刻が8:29:00まで入力してあります。

上記の関数を条件付き書式のルールに設定し、適応先をF3〜(始業時間が入力してあるF2行の下の行)に設定・条件に当てはまるセルの色付けすることで、機械のスタート・ストップがA3,A4セルに入力されると、その時間の間のセルに色が付けられ、稼働時間がわかる というものを作りました。
(再び機械を動かすと、以降の時刻はA5以降の列に入力されていきます。)

セルへの入力は、機械の入力信号をキー入力に変換する機器を用いて以下のVBAコードによりセルへ入力されるようにしてあります。
(↓ 機械の入力信号をキー入力Aに変換し、フォーカス中にキー入力Aが行われると時刻がA列のセルに入力されます。)

Private Sub TextBox0_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

If KeyCode = 65 Or KeyCode = 97 Then
Sheets("集計シート").Cells(65536, "A").End(xlUp).Offset(1, 0).Value = Format(Time, "HH:MM:SS")
TextBox0 = ""
End If

End Sub

前置きが長くなりましたが、質問させて頂きたいのは、上記のガントチャートで現状発生している問題についてです。

上記の方法で条件付き書式を設定すると、A3,A4 A5,A6...といった具合にスタート・ストップの対になるセルが入った関数を一つ一つ設定していく必要があり、又、一つのルールの書式に入力できる文字数にも限界があり、頻繁にスタート・ストップする機械においては設定されている書式以上に入力される時刻のデータ数が多くなってしまいます。
(実際に入力してみると、A260くらいまでが書式設定に入力できた文字数の限界で、機械を24時間回すとA400列以上まで機械の稼働時刻が入力されていました。)

つきましては、上記の方法をVBAに置き換えて条件に適応させる列のセル数を増やすことは出来ませんでしょうか?

http://www.excel.studio-kazu.jp/kw/20200521100440.html
直近で条件付き書式をVBAコードで実行する方法を質問されていた方がいましたので、これを応用すればコードから条件付き書式を設定することは出来そうですが、小生 VBAコードについての知識が乏しく、行き詰っております。

宜しくお願い致します。

< 使用 Excel:Excel2019、使用 OS:Windows10 >


条件付き書式に設定する数式として、下記でいかがでしょうか。

 =ISODD(MATCH(F5+TIME(0,0,1),$A$3:$A$1000,1))

ただし、0:00〜8:29は、工夫が必要ですが...
(通りがかった旅人) 2020/05/25(月) 13:56


通りがかった旅人 様

返信ありがとうございます。

早速試してみました。ISODD関数を使うのですね!考えつきませんでした。勉強になります。
0:00〜8:29については、入力される信号の時刻を30時間制とすることで解決できました。

一点、問題が。。。機械がスタートした時間の信号のみ入力されている状態であると、以降の8:29:00までの全てのセルに色が付いてしまうことです。他に条件を付けて解消できればよいのですが。。。
(高梨) 2020/05/25(月) 14:15


>機械がスタートした時間の信号のみ入力されている状態

気づきませんでした。。

現在時刻より前に限定すればよろしいかと思います。

 =AND(F2<MOD(NOW(),1),ISODD(MATCH(F2+TIME(0,0,30),$A$3:$A$74,1)))

これも、0:00〜8:29を考慮していません。
(通りがかった旅人) 2020/05/25(月) 15:03


> =AND(F2<MOD(NOW(),1),ISODD(MATCH(F2+TIME(0,0,30),$A$3:$A$74,1)))

ありがとうございます。試してみましたが、動作してくれません。。。

又、MATCH関数の検査範囲を広くすることは可能なのでしょうか?
入力できるデータ範囲を増やそうと、試しに検査範囲を $A$3:$A$1048576 に書き換えてみたのですが先にご教授頂いたISODD関数のコードで検索範囲を変化させると動作しなくなってしまいました。
(高梨) 2020/05/25(月) 16:44


>検索範囲を変化させると動作しなくなってしまいました

よくわかりませんが、検査範囲は「$A:$A」としてもいいでしょう。

(通りがかった旅人) 2020/05/25(月) 17:07


  >試してみましたが、動作してくれません。。。 

  それは無理もないでしょう。
  現実のデータの在り様は考慮していない、って明言しているんですから。

  >F2には始業時間8:30:00が入力してあり、
  >E2以降の2の行には、8:31:00、8:32:00といった具合に1分経過ごとの時刻が
  >8:29:00まで入力してあります。 
    ↑
  1.これは本当に8:29なんですか? それとも実体は32:29なのですか?

  >0:00〜8:29については、入力される信号の時刻を30時間制とすることで解決できました。 
  2.30時間制とは何ですか? 
    48時間制なら、分からないでもないですが。

(半平太) 2020/05/25(月) 17:28


 ↑
 上の照会は撤回します。やり易い様に変更すればいいだけなので。。 
 代わりに、以下、確認させてください。

 1.1分毎に塗りつぶしって細かすぎないですか?
   1440セルもあったら、見るのが大変と思うんですが。

 2.開始時刻を入れてから、終了時刻を入れる直前までは塗りつぶし無しでいいんですか?

   よくない場合、どう言うタイミングで塗り直すのがいいですか?
   ※自動的に塗り直されることはないので、何か工夫が必要になります。

(半平太) 2020/05/26(火) 07:32


>半平太 様

おはようございます。
返信ありがとうございます。

>1.1分毎に塗りつぶしって細かすぎないですか?
>  1440セルもあったら、見るのが大変と思うんですが。

 停止する頻度の多い機械なので、停止と稼働の状況を知るために1分毎のデータで反映させます。
セルの幅を1ピクセルまで縮めて出来るだけ見やすくはしています。
求められている仕様上必要ではあるのですが、確かに細かすぎるとは思います。
 もっと別の方法で同等のものが出来ればいいのですが、小生の知識ではこの方法しか思いつかなかったので、今回はこのようなやり方をさせて頂いております。すみません。
 (余談ですが、今回のガントチャートはPowerPointにリンクさせてスライドショーで稼働状況をリアルタイム更新するデジタルサイネージとして工場内モニターに反映させて見える化するためのものです。)

>2.開始時刻を入れてから、終了時刻を入れる直前までは塗りつぶし無しでいいんですか?
>  よくない場合、どう言うタイミングで塗り直すのがいいですか?
>  ※自動的に塗り直されることはないので、何か工夫が必要になります。

 はい。開始時刻を入れてから、終了時刻を入れる直前までは塗りつぶし無しで結構です。
 欲を言えば、開始時刻を入れてから、1分経過したタイミングでセルを塗りつぶす仕様がいいかな とは思います。
(高梨) 2020/05/26(火) 08:58


 1.F2セル以降の翌日0:00〜8:29の時刻データの実体値は、1:00なら25:00にする(表示をどうするかは自由)
 2.A3セル以降の翌日0:00〜8:29の時刻データの実体値は、1:00なら25:00にする(表示をどうするかは自由)
   このため、TextBox0_KeyDownを少し書き換える
 3.自動更新は1分毎とする。(但し、稼働停止中は更新しない。更新しても、しなくても同じ結果なので)

 上記1と条件付き書式設定は、面倒なので、一回こっきりのVBAを使って設定する。
 安全の為、バックアップを取ってテストしてください。

 その後、希望色に変更してください(手作業)

 '時間枠設定と条件付き書式設定(1回こっきりの実行)
 Sub InitialSetting()

     With Sheets("集計シート").Range("F2:BCO2")
         .FormulaR1C1Local = "=TEXT(RC[-1]+""0:01"",""[h]:mm"")*1"
         .Offset(0, -1)(1, 1) = TimeSerial(8, 30, 0)
         .Value = .Value

         With .Offset(1).FormatConditions
             .Add Type:=xlExpression, Formula1:= _
              "=ISODD(MATCH(F2+""0:0:01""*1,$A$3:$A$10000,1))*(F2<=(MOD(NOW(),1)+(MOD(NOW(),1)<=""8:30""*1)))"

             .Item(.Count).SetFirstPriority
             .Item(1).Interior.Color = RGB(255, 0, 0)
             .Item(1).StopIfTrue = False
         End With
     End With
 End Sub

 ’標準モジュールに貼り付け-------------- 
 Sub UpDate()
     With Application
         .ScreenUpdating = True
         .Caption = .Text(Now + TimeValue("00:01:00"), "次回更新 hh:mm:ss")
         .OnTime CDate(Split(.Caption)(1)), "UpDate", , True
     End With
 End Sub

 Sub endUpdate()
     With Application
         On Error Resume Next
             .OnTime CDate(Split(.Caption)(1)), "UpDate", , False
         On Error GoTo 0

         .Caption = Empty
     End With
 End Sub

 ’集計シート(Userform?)のモジュールへ貼り付け---------------

 Private Sub TextBox0_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

     Dim Tm As Double
     If KeyCode = 65 Or KeyCode = 97 Then
         Call endUpdate
         Tm = Time

         If Tm <= TimeSerial(8, 29, 0) Then  '8:29までなら翌日扱い
             Tm = Tm + 1
         End If

         With Sheets("集計シート").Cells(65536, "A").End(xlUp).Offset(1, 0)
             .Value = Tm
             .NumberFormatLocal = "h:mm:ss"  '見かけを整える
             If Application.IsOdd(.Row) Then '開始後は1分間隔で色更新
                 Call UpDate
             End If
         End With

         TextBox0 = ""
     End If
 End Sub

 ’Thisworkbookモジュールへ貼り付け -------------
 Private Sub Workbook_BeforeClose(Cancel As Boolean)
     Call endUpdate
 End Sub

(半平太) 2020/05/26(火) 12:52


ありがとうございます!

テストしてみたところ、スタートの入力信号が入った時、実行時エラー '13が
標準モジュール: .OnTime CDate(Split(.Caption)(1)), "UpDate", , True にて発生してしまいます。
ストップ時の入力信号が入った時にはエラーが発生しないのですが。。。

(高梨) 2020/05/26(火) 13:47


 >標準モジュール: .OnTime CDate(Split(.Caption)(1)), "UpDate", , True にて発生してしまいます。

 その時 Application.Caption には何が入っていますか? 

 イミディエイトウィンドウに
 と入れれば分かりますが。
 ↓ 
 ? "#" & Application.Caption & "#" 

(半平太) 2020/05/26(火) 14:00


エラーが発生した状態でイミディエイトウィンドウに入力すると、

#ガントチャート.xlsm - 次回更新 14:04:10#

と表示されました。
(高梨) 2020/05/26(火) 14:04


 そうですか・・ちょっと納得いかないですが、
 以下に換えてみて下さい。

 > .OnTime CDate(Split(.Caption)(1)), "UpDate", , True にて発生してしまいます。 
      ↓
   .OnTime CDate(Split(.Caption, "次回更新 ")(1)), "UpDate", , True

(半平太) 2020/05/26(火) 14:29


エラー解消できました!
1分毎の自動更新も問題なく動作できています。
ありがとうございます!!
(高梨) 2020/05/26(火) 16:04

すみません。最後に一点質問なのですが、
仮に複数の機械の稼働状況を記録しようとした場合、2台目のガントチャートをすぐ下の行に表示させるとして、入力信号:キー入力"B"で、B列に時刻を記録していくとすると、

時間枠設定と条件付き書式設定で、一回こっきりの実行を↓のように行い、

 Sub InitialSetting()
     With Sheets("集計シート").Range("F2:BCO2")
         .FormulaR1C1Local = "=TEXT(RC[-1]+""0:01"",""[h]:mm"")*1"
         .Offset(0, -1)(1, 1) = TimeSerial(8, 30, 0)
         .Value = .Value
         With .Offset(1).FormatConditions
             .Add Type:=xlExpression, Formula1:= _
              "=ISODD(MATCH(F2+""0:0:01""*1,$B$3:$B$10000,1))*(F2<=(MOD(NOW(),1)+(MOD(NOW(),1)<=""8:30""*1)))"
             .Item(.Count).SetFirstPriority
             .Item(1).Interior.Color = RGB(255, 0, 0)
             .Item(1).StopIfTrue = False
         End With
     End With
 End Sub

TextBox0_KeyDownのコードに↓のIF文を追加する

     If KeyCode = 66 Or KeyCode = 98 Then
         Call endUpdate
         Tm = Time
         If Tm <= TimeSerial(8, 29, 0) Then  '8:29までなら翌日扱い
             Tm = Tm + 1
         End If
         With Sheets("集計シート").Cells(65536, "B").End(xlUp).Offset(1, 0)
             .Value = Tm
             .NumberFormatLocal = "h:mm:ss"  '見かけを整える
             If Application.IsOdd(.Row) Then '開始後は1分間隔で色更新
                 Call UpDate
             End If
         End With
         TextBox0 = ""
     End If

でよろしいでしょうか?
(高梨) 2020/05/26(火) 17:34


  あれ? すみません。

  オリジナルからして、先頭がE列にずれてますね。(以下に訂正要です)

        .Offset(0, -1)(1, 1) = TimeSerial(8, 30, 0)
      ↓   
  (正)  .Cells(1, 1) = TimeSerial(8, 30, 0)

  4行用
  ※ 条件付き書式は、見る先が2行目と決まっているので、F$2 と絶対参照にする。

   Sub InitialSetting()
       With Sheets("集計シート").Range("F2:BCO2")
           .FormulaR1C1Local = "=TEXT(RC[-1]+""0:01"",""[h]:mm"")*1"

  '         .Offset(0, -1)(1, 1) = TimeSerial(8, 30, 0)’間違い
           .Cells(1, 1) = TimeSerial(8, 30, 0)  '訂正後

           .Value = .Value
           With .Offset(2).FormatConditions
               .Add Type:=xlExpression, Formula1:= _
                "=ISODD(MATCH(F$2+""0:0:01""*1,$B$3:$B$10000,1))*(F$2<=(MOD(NOW(),1)+(MOD(NOW(),1)<=""8:30""*1)))"
               .Item(.Count).SetFirstPriority
               .Item(1).Interior.Color = RGB(255, 0, 0)
               .Item(1).StopIfTrue = False
           End With
       End With
   End Sub

 KeyDownの方は、中身は問題ないと思いますが、同じ「TextBox0」でいいとは思えないです。
 いずれにしても、これはそちらだけでご判断いただくマターと考えます。

(半平太) 2020/05/26(火) 19:17


 稼働停止中は、自動更新はしない仕様でしたが、2系列あるとそうもいかないです。

 一方が引き続き稼働している可能性がありますから。
 その対策は、そちらで施してください。

(半平太) 2020/05/26(火) 21:05


添削頂きましてありがとうございます。

2台稼働での稼働・停止も確認しましたが、一方が止まっている時も稼働中の一方の
ガントチャートはしっかり記録出来ていました。
時間表記を [h]:mm:ss に変更して24時間以上の時刻表示にしてみたら深夜時間の入力もしっかり
ガントチャートに反映出来ました。
(PCの現在時刻をいじっての確認だったので、これから実機で検証してみます。)
ご指摘頂いた様に、2系列以上を同じTextBox0だけでKeyDownさせるのは問題が出てきそうですので
何か別の方法も考えてみます。

長々とお付き合いいただきありがとうございました!
(高梨) 2020/05/29(金) 16:15


コメント返信:

[ 一覧(最新更新順) ]


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