VBAのapplication.ontime メソッドでの日付を超えた設定方法について

このQ&Aのポイント
  • VBAのapplication.ontime メソッドを使用して、日付を超えた設定をする方法について説明します。
  • 測定器からデータを取得するためのEXCEL VBAのプログラムで、application.ontime メソッドを使用して、指定の時間に測定マクロを起動する方法を探しています。
  • プログラムでは、測定開始時刻からの経過時間を表に書き込み、それを読み込んで application.ontime メソッドで起動しようとしていますが、日付が変わると動作が止まってしまいます。日付を指定して日付超えの時刻を設定する方法について、上手な設定方法を知りたいです。
回答を見る
  • ベストアンサー

VBAのapplication.ontime メソッドでの日付を超えた設定方法について

VBAのapplication.ontime メソッドでの日付を超えた設定方法について EXCEL VBAを使って、2×10^n, 5×10^n, 10×10^n (n=2~6)秒ごとに 測定器からデータを取得する下のようなプログラムを作りました。 測定開始時刻から起算した時刻を表に書き込み、それを読み込んで application.ontimeで測定マクロを起動しようとするものです。 Dim clk, clk2, clk5, clk10 As Variant Dim i, j, n As Integer Sheet1.Range("A1") = Date Sheet1.Range("B1") = Time Sheet1.Range("C1") = Now Sheet1.Range("D1") = 6 '時刻表の読取り開始位置指定 n = 6 '時刻表の書込み開始位置指定 clk = Now '開始時刻設定 For i = 3 To 5 c2 = 2 * 10 ^ i Sheet1.Range("A" & LTrim(Str(n))) = c2 * 1000 '繰返し回数 2×10^i(k回) clk2 = DateAdd("s", c2, clk) '2×10^i(k回)の時刻計算 Sheet1.Range("B" & LTrim(Str(n))) = clk2 '時刻表への書込み mdate = CStr(Format(clk2, "yyyy/mm/dd")) '日付の抽出 mtime = Format(clk2, "h:m:s") '時刻の抽出 Sheet1.Range("C" & LTrim(Str(n))) = mdate '日付の書込み Sheet1.Range("D" & LTrim(Str(n))) = mtime '時刻の書込み n = n + 1 '時刻表書込み位置を1進める c5 = 5 * 10 ^ i Sheet1.Range("A" & LTrim(Str(n))) = c5 * 1000 clk5 = DateAdd("s", c5, clk) Sheet1.Range("B" & LTrim(Str(n))) = clk5 mdate = CStr(Format(clk5, "yyyy/mm/dd")) mtime = Format(clk5, "h:m:s") Sheet1.Range("C" & LTrim(Str(n))) = mdate Sheet1.Range("D" & LTrim(Str(n))) = mtime n = n + 1 c10 = 10 * 10 ^ i Sheet1.Range("A" & LTrim(Str(n))) = c10 * 1000 clk10 = DateAdd("s", c10, clk) Sheet1.Range("B" & LTrim(Str(n))) = clk10 mdate = CStr(Format(clk10, "yyyy/mm/dd")) mtime = Format(clk10, "h:m:s") Sheet1.Range("C" & LTrim(Str(n))) = mdate Sheet1.Range("D" & LTrim(Str(n))) = mtime n = n + 1 Next i For j = 6 To 14 mdate = Str(Sheet1.Range("C" & LTrim(Str(j)))) '測定日付読込み mtime = Sheet1.Range("D" & LTrim(Str(j))) '測定時刻読込み 待ち時間 = TimeValue("0時00分30秒") Application.OnTime (mtime) + DateValue(mdate), "measure", TimeValue(待ち時間) Next j End Sub 同日付の間は動くのですが、日付が変わると止まってしまいます。 Ontimeメソッドでは日付を指定すれば日付超え時刻指定ができると 聞き、日付、時刻を別の変数として指定する方法も試しましたが、型が一致しないエラーが出て困っています。 Application.OnTime TimeValue(mtime) + DateValue(mdate),  ・・・ 上手い設定方法はないものでしょうか

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

  • ベストアンサー
  • fujillin
  • ベストアンサー率61% (1594/2576)
回答No.1

コードはよく見てませんが… 充分に先の時間(数秒後?)であることがわかっているのですから、  expression.OnTime(EarliestTime, Procedure) の構文を利用すればいいのでは? 今からd日(d:整数) と hh:mm:ss 時間後にスタートであれば  Application.OnTime Now + n + TimeValue("hh:mm:ss") , "measure" でいけると思います。 >型が一致しないエラーが出て困っています。 TimeValueは24時間を越える数値だと、このエラーになるようですが、それが原因ではないでしょうか?

keramos
質問者

お礼

ありがとうございました。 測定日時、測定時刻の指定方法を見直して見ました。 VBAは初心者なのでマニュアルやヘルプ画面と首っ引きで マクロを作成していますが、なかなか進展しません。

keramos
質問者

補足

ご指摘ありがとうございました。 試しに単純化した下のマクロを実行しPCの時計を一時的に進めてテストしたところ、所望の動作を確認することができました。 Sub test() Dim mtime, mdate, clk, c, d As Variant Sheet1.Range("A1") = Date Sheet1.Range("B1") = Time Sheet1.Range("C1") = 3 For i = 3 To 6 d = Sheet1.Range("A" & LTrim(Str(i)))  '日差指定 c = Sheet1.Range("B" & LTrim(Str(i)))  '時差指定 mdate = DateAdd("d", d, Date)      '動作日付計算 mtime = DateAdd("s", c, Time)      '動作時刻計算 Sheet1.Range("C" & LTrim(Str(i))) = mdate Sheet1.Range("D" & LTrim(Str(i))) = mtime Application.OnTime TimeValue(mtime) + DateValue(mdate), "print_txt" Next i End Sub 結局、他のジョブと競合した場合の待ち時間指定に付けていたLatestTimeを削除したところ、問題なく動くことがわかりました。 本番のマクロに組み込んで、テストしてみようと思います。

関連するQ&A

  • Excel2007VBA 日付の加算について

    ●質問の主旨 コピー元のシートの特定セル(A3セル)に入力されている日付に対して 加算を行い、その加算した日付をシート名とコピー先の シートの特定セルに入力するためにはどうすればよいでしょうか? 具体的には下記のコードをどのように書き換えればよいでしょうか? 「Worksheets(i + 1).Name = mydate」のところでエラーが出てしまいます。 ご存知の方、ご教示願います。 ●コード Sub 一週更新() Application.ScreenUpdating = False Dim i As Integer Dim mydate As Date '既存のシート数を取得 i = ThisWorkbook.Worksheets.Count '最終シートをコピーして後ろに挿入 Worksheets(i).Copy after:=Worksheets(i) 'mydateは最終シートのA3セルに入力されている日付の1週間後の日付とする mydate = DateAdd("ww", 1, Worksheets(i).Range("A3")) '追加したシートのシート名はmydate2の日付とする Worksheets(i + 1).Name = mydate '新しく作成したワークシートについて以下の処理を行う With ActiveSheet Range("A3") = mydate Range("A12").ClearContents Range("A19").ClearContents Range("A26").ClearContents Range("A32").ClearContents End With Application.ScreenUpdating = True End Sub ●補足 上記コードは週単位の報告書を作成するためのコードです。 コピー元のA3セルは表示上は9/16となっており、 「セルの書式設定上」は「日付」→「3/14」, ロケールは日本語です。 私はVBA初心者です。

  • VBAにて実行時エラー’1004’:「アプリケーション定義又はオブジェクト定義のエラー」発生?

    VBA初心者です。Xp,Excel2000を使用しています。 シフト者のカレンダー作成しており、動作していたVBAのコピーを利用しています。 何回かループを回った後表記エラーとなります。アドバイスをお願いいたします。   A B C D E -------------------------- 1 2 3 4 ...... <-- 日付 2 2 0 1 ...... <-- シフト(ln_1の範囲名) 7 8 9 10 ...... <-- 日付 1 0 3 3 ..... <-- シフト(ln_2の範囲名) .................... For i = 1 To 6   <-- 最大6週にわたる Set r = Range("ln_" & LTrim$(Str$(i))) cpos = r.Column rpos = r.Row For n = 1 To r.Columns.Count With Cells(rpos - 1, cpos + n - 1) m = .Characters.Count <-- 数回ループ後ここでエラーとなる! s = Cells(rpos, cpos + n - 1) <-- シフト情報 Select Case s Case ""    '- Blank - ........ 日付セルの装飾 Case "0" '- Holiday - ......... 日付セルの装飾 Case "1" '- shift1 - ........... 日付セルの装飾

  • エクセルVBA シートにある日付1週間分転記

    お世話になります、Sheet1,Range(”A3")からFirstRow、Range(”A")にナンバーSheet1Range(”B")に日付Range(”C")に曜日Range(”D3")に会社名Range(”E")に行先名があります。 Sheet1Range(”B")にある日付1週間分をsheet2~sheet8に転記。sheet2には今日の日付をsheet3には翌日の日付を~sheet8までそれぞれ1週間分転記し、これを1日ごとクリアーかデリートしてから更新する構文をどなたかご教示お願いします。

  • VBA(エクセル)での条件付日付表示について

    A列に数字を入力、A25でA列の合計をするべく「=SUM(A1:A24)」という計算式の入ったシートがあるとします。(以下、B、C…と同じような列が続く) A列に入力されている数字が変更され、A25の合計値が変わった場合、その下のセル(A26)に日付と時刻を表示させたいのですが、うまくいきません。 ネットで検索したら、特定のセルの値が変更された時に日付と時刻を表示させる方法は何となくわかったのですが、この場合だと、直接A25のデータ変更された時のみA26に日付が表示されるだけで、A25の合計値がいくら変わったところで最新の時刻を表示させる事が出来ません。 どうすれば、A26に時刻を表示出来るのでしょうか? EXCEL、VBA初心者共に初心者で、あまりよくわかっていなくて申し訳ないのですが、どうぞご教授よろしくお願いします。 Private Sub Worksheet_Change(ByVal Target As Range) Dim myRng As Range Dim i As Range Set myRng = Me.Application.Intersect(Target, Me.Range("25:25")) If Not myRng Is Nothing Then Application.EnableEvents = False For Each i In myRng If IsEmpty(i.Value) Then i.Offset(1, 0).ClearContents Else i.Offset(1, 0).Value = Now End If Next i Application.EnableEvents = True End If End Sub

  • Excel2010 VBAについて

    以下のソースを書いて実行したのですが 「実行エラー'1004' WorksheetFunctionクラスのVlookupプロパティを取得できません」 と表示されます Sub 時刻表示() '日本の時間と選択した年の時刻・時差を1秒ごとに表示しなおす Dim City As String Dim Jisa As Long Application.ScreenUpdating = False City = Range("C6").Value Jisa = WorksheetFunction.VLookup(City, _ Worksheets("都市リスト").Range("B3:C14"), 2, False) Range("E7").Value = Jisa Range("C4").Value = Now Range("C7").Value = DateAdd("h", Jisa, Now) Range("C4, C7").NumberFormat = "m/d h:mm:ss" Application.ScreenUpdating = True Application.OnTime Now + TimeValue("0:00:01"), "時刻表示" End Sub Sub 時刻表示終了() '時計を止める Application.OnTime Now + TimeValue("0:00:01"), "時刻表示", Schedule:=False End Sub デバックをすると Application.OnTime Now + TimeValue("0:00:01"), "時刻表示", Schedule:=False がマーカーで引かれます 一応本通りには打ったと思うのですが、、、。 どこが間違えているか教えてください

  • EXCEL VBA で列の数字のみを修正No.2

    前回の応用の質問になります。 EXCEL VBA で列の数字のみを修正したいのですが 内容としては (1)カッコ内文字はそのまま維持 (2)添付資料のN001から始まっているまたはN001以外の始まる、ある機械加工プログラムに   N053,N054を挿入しプログラム内容はそのまま変更なく使用 ここで始めたいNナンバー数値(例N075からの連番)にマクロで変換したいのですが おすすめのコードを教えてください。 (※SHEET1のA列に記載されているとして) 前回の質問時はN001からの連番を以下のコードでできました。 Sub test() Dim i As Long Dim j As Long Dim str As String i = 1 j = 1 str = Worksheets("sheet1").Range("A" & i).Value Do While str <> "" If Left(str, 1) = "N" Then str = "N" & Format(j, "000") & Mid(str, 5, Len(str) - 4) Worksheets("sheet1").Range("A" & i).Value = str j = j + 1 End If i = i + 1 str = Worksheets("sheet1").Range("A" & i).Value Loop End Sub いろいろコードを触ってみましたが思うように出来ずに困っています。 よろしくお願いします

  • マクロ 未来の日付を算出する その2

    まだまだ未熟な者です。 年と月と日の加算を同時に成立させて、未来の日付を表示させようかなと思っています。加算を同時成立させる方法が分からなくて、以下の方法を取りましたが、マクロがまともに動きません。以下の記述方法の場合、どの点が間違っているのでしょうか?御指導お願いします。 Sub 周期到達日を算出する(2)() Sheets("日付").Range("C6").Value = DateAdd("yyyy", Range("C3"), "1900/1/0") Sheets("日付").Range("C7").Value = DateAdd("m", Range("C4"), "1900/1/0") Sheets("日付").Range("C8").Value = DateAdd("d", Range("C5"), "1900/1/0") Sheets("日付").Range("C10").Value = Range("C3") + Range("C4") + Range("C5") + Range("C9") End Sub

  • Excel VBAでセルに書いた時刻を取得したいのに・・・

    ExcelのVBAで、OnTimeを使い、 定時に印刷させるプログラムを組んでいます。 今までOnTimeの時刻設定に直接時刻を入れ込んでいたのですが、 ワークシートに登録した時刻を使うようにしたいと思い、 次のようにしたのですが、 Setのところの変数名で「オブジェクトが必要です」エラーが出ます。 ・・・何が悪いのでしょうか? Dim routinetime1 As String Dim routinetime2 As String Dim routinetime3 As String Set routinetime1 = Range("A1").Value Set routinetime2 = Range("B2").Value Set routinetime3 = Range("C3").Value Application.OnTime TimeValue(routinetime1), "印刷プロシージャ" Application.OnTime TimeValue(routinetime2), "印刷プロシージャ" Application.OnTime TimeValue(routinetime3), "印刷プロシージャ" よろしくお願いいたします。

  • 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#)になっており、これが原因だと考えています。 このエラーを回避し、初期値の場合でも値がきちんとセルにセットされるようにするには、どうしたらよいでしょうか?

  • VBAの日付範囲の抽出について

    作業SheetのC列から日付で範囲指定して検索された行を検索workへ行をコピーしたいのですが、 日付の抽出がうまくできません。どなたかご教授願います。 また、できることなら、オートフィルタを利用せずに抽出したいのですが、書き方がわかりません。 素人の質問で申し訳ございませんが、よろしくお願いします。   開始年月日 = ">=" & S受付日Box.Text 終了年月日 = "<=" & E受付日Box.Text Worksheets("作業Sheet").Range("C1").AutoFilter _ Field:=3, _ Criteria1:=開始年月日, _ Operator:=xlAnd, Criteria2:=終了年月日 Worksheets("作業Sheet").Range("A2").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _ Worksheets("検索work").Range("A2") Worksheets("検索work").Range("2:2").Delete 'タイトル行の削除 MsgBox "抽出が完了しました。「検索結果の表示」ボタンから確認してください"

専門家に質問してみよう