エクセルで定期的（30分おき）にマクロを実行させる方法は？

Question

エクセルにて刻一刻変る外部データ（株価）を表示させています。それを自動で30分置きにデータ蓄積させる方法はありませんか？

現在は自分で作ったキーボードマクロで　時計を見ながらボタンを押し、データを取り込ん出る始末です。

その簡単マクロに「30分置きに実行させる」と云う記述を付け足す程度で自動実行させる事は可能でしょうか？　
当方キーボードマクロでの自動書き込みしか出来ない素人ですが、少々複雑な物であっても頑張ってみるつもりですので、どなたかご教授下さい。

KenKen_SP · Accepted Answer

えーー。。実際に使うなら、zap35 さんのように、OnTime で実行したマクロ
の中で再度 OnTime を登録する方が良いと思います。

この方式だと、OnTime で登録されるのは常に一つだから管理し易いです。
これに未実行の予約を破棄できる仕組みを組み込めばベストだと思います。

今更こんな事言うのは、#6 の大げさなコードを見て、「また、やっちまった...」
と反省しているからです。が、#6 をアップしてしまった以上、それなりに
まとめておきました。こちらは、一括登録方式です。

コードのままだと、午前10時～午後6時まで30分間隔で Macro1 を実行します。
変更点は、

　・ブッククローズをトラップした
　・進捗状況をステータスバーに表示するようにした
　・その他しょうもないこと

です。

このままコピペで使えると思いますが、試される場合は、MACRO1 はご自分の
用途に合わせて適切に修正して下さい。


Option Explicit

Dim mcolTask As Collection

Sub 実行予約()

　　Dim i　　　　　 As Date
　　Dim strProcName As String
　　Dim datBigin　　As Date
　　Dim datEnd　　　As Date
　　Dim datInterval As Date
　　Dim datTimeout　As Date
　　Dim blnJustTime As Boolean

　　' Setting-------------------------------------------------------

　　datBigin = TimeValue("10:00:00")　　' 開始時刻
　　datEnd = TimeValue("18:00:00")　　　' 終了時刻
　　datInterval = TimeValue("00:30:00") ' 実行間隔(少なくとも数秒以上で）
　　datTimeout = TimeValue("00:02:00")　' 実行待機タイムアウト
　　blnJustTime = True　　　　　　　　　' datInterval で丸めるか
　　strProcName = "MACRO1"　　　　　　　' 実行するマクロ名

　　'---------------------------------------------------------------

　　' 既に実行予約されているか確認
　　If mcolTask Is Nothing Then

　　　　' 日付シリアル値を加算
　　　　datBigin = datBigin + Date
　　　　datEnd = datEnd + Date
　　　　' 終了時刻が開始時刻より小さければ日をまたぐので補正
　　　　If datEnd < datBigin Then datEnd = datEnd + 1
　　　　' 現在時刻が既に終了時刻を過ぎている場合
　　　　If datEnd < Now() Then
　　　　　　MsgBox "終了時刻を過ぎているため予約できません。", vbCritical, "終了"
　　　　　　Exit Sub
　　　　End If
　　　　' 現在時刻が開始時刻を過ぎていれば補正
　　　　If datBigin < Now() Then
　　　　　　' 開始時刻を datInterval で指定された値で丸めるか
　　　　　　If blnJustTime Then
　　　　　　　　datBigin = Application.Floor(Now() + datInterval, datInterval)
　　　　　　Else
　　　　　　　　datBigin = Now() + datInterval
　　　　　　End If
　　　　End If

　　　　' 初期化
　　　　Set mcolTask = New Collection

　　　　' メイン部分
　　　　For i = datBigin To datEnd Step datInterval
　　　　　　' 後から取り消せるようにコレクションに退避
　　　　　　mcolTask.Add CStr(i) & "," & strProcName
　　　　　　' Application.Ontime で実行予約を行う
　　　　　　Application.OnTime EarliestTime:=i, _
　　　　　　　　　　　　　　　 Procedure:=strProcName, _
　　　　　　　　　　　　　　　 LatestTime:=i + datTimeout, _
　　　　　　　　　　　　　　　 Schedule:=True
　　　　Next i
　　Else
　　　　MsgBox "既に実行中です", vbInformation
　　End If

End Sub

Sub 未実行予約強制解除()
　
　　Dim i　　As Long
　　Dim vntS As Variant
　
　　On Error Resume Next
　　Application.StatusBar = "タスク破棄中... "
　　For i = 1 To mcolTask.Count
　　　　vntS = Split(mcolTask.Item(i), ",")
　　　　Application.OnTime CDate(vntS(0)), CStr(vntS(1)), Schedule:=False
　　Next i
　　Application.StatusBar = ""
　　Set mcolTask = Nothing

End Sub

' タスク管理用
Private Sub RemoveTask()
　　
　　On Error Resume Next
　　mcolTask.Remove (1)
　　Application.StatusBar = "待機中のタスク... " & mcolTask.Count
　　DoEvents
　　Beep
　　If mcolTask.Count = 0 Then
　　　　Application.StatusBar = ""
　　　　Set mcolTask = Nothing
　　End If

End Sub

Sub Auto_Close()

　　Dim intRes As Integer
　　If Not mcolTask Is Nothing Then
　　　　intRes = MsgBox( _
　　　　　　　　Prompt:="待機中のタスクが " & mcolTask.Count & " 件あります。" & vbLf _
　　　　　　　　　　　& "破棄して終了しますか？", _
　　　　　　　　Buttons:=vbOKCancel + vbDefaultButton2 + vbExclamation, _
　　　　　　　　Title:="問い合わせ")
　　　　If intRes = vbOK Then
　　　　　　Call 未実行予約強制解除
　　　　Else
　　　　　　' ブッククローズをキャンセル
　　　　　　Application.ExecuteExcel4Macro ("Halt(True)")
　　　　End If
　　End If

End Sub

' 呼び出すマクロ--＞ Application.Ontime のマクロ名と一致させて下さい
Sub MACRO1()

　　Dim lngRow As Long
　　With ThisWorkbook.Sheets("Sheet1")
　　　　lngRow = .Range("V65536").End(xlUp).Offset(1).Row
　　　　.Cells(lngRow, "V").Resize(1, 3).Value = .Range("Q12:S12").Value
　　　　.Cells(lngRow, "Y").Value = Now()
　　End With

　　' ご自分のマクロの最後に次の一行を追加しておいて下さい
　　Call RemoveTask

End Sub

KenKen_SP · Answer

あ、、、すみません。

Setting 欄、コメントと全然違いますね。
30秒間を10秒間隔でテストしたときのものです。
直すの忘れました。

適切に書き直して下さい。

KenKen_SP · Answer

Application.OnTime は手軽な反面、結構扱いが難しいかもしれません。実行
予約のキャンセルとか、２重予約のトラップとか。

その辺も含めてコーディングしてありますが、ザッと作ったので穴があるかも
しれません。

実行予約の Setting という場所を変更してみて下さい。

あとは、OnTime だと待機中は普通に Excel が使えてしまうので、不意にブック
が閉じられてしまうのをトラップする必要があるかもしれません。

ご参考までに。では。


Option Explicit

Dim mcolTask　As Collection

Sub 実行予約()

　　Dim i　　　　　 As Date
　　Dim strProcName As String
　　Dim datBigin　　As Date
　　Dim datEnd　　　As Date
　　Dim datInterval As Date

　　' Setting-------------------------------------------------------
　　' 開始時刻: 例えばマクロが実行された時刻
　　datBigin = Now()
　　' 終了時刻: 例えば当日午後6時まで
　　datEnd = Now() + TimeValue("00:00:30")
　　' 実行間隔: 例えば5秒間隔
　　datInterval = TimeValue("00:00:10")
　　' 実行するマクロ名
　　strProcName = "MACRO1"
　　'---------------------------------------------------------------

　　' 既に実行予約されているか確認
　　If mcolTask Is Nothing Then
　　　　
　　　　' 初期化
　　　　Set mcolTask = New Collection
　　　　' 開始時刻が現在時刻より早い場合は補正
　　　　If datBigin < Now() Then datBigin = datBigin + datInterval
　　　　
　　　　' 実行予約メイン部分
　　　　For i = datBigin To datEnd Step datInterval
　　　　　　' 後から取り消せるように退避しておきます
　　　　　　mcolTask.Add CStr(i) & "," & strProcName
　　　　　　' Application.Ontime で実行予約します
　　　　　　Application.OnTime i, strProcName, Schedule:=True
　　　　Next i
　　
　　Else
　　　　MsgBox "既に実行予約されています", vbInformation
　　End If

End Sub

Sub 未実行予約強制解除()
　　
　　Dim i　　As Long
　　Dim vntS As Variant
　　
　　On Error Resume Next
　　For i = 1 To mcolTask.Count
　　　　vntS = Split(mcolTask.Item(i), ",")
　　　　Application.OnTime CDate(vntS(0)), CStr(vntS(1)), Schedule:=False
　　Next i
　　Set mcolTask = Nothing

End Sub

' タスク管理用
Private Sub RemoveTask()
　　
　　mcolTask.Remove (1)
　　If mcolTask.Count = 0 Then
　　　　Set mcolTask = Nothing
　　End If

End Sub


' 呼び出すマクロ--＞ Application.Ontime のマクロ名と一致させて下さい
Sub MACRO1()

　　'シート名は明示的に指定した方が良いですよ
　　With ThisWorkbook.Sheets("Sheet1")
　　　　.Activate
　　　　.Range("Q12:S12").Copy
　　　　.Range("V65536").End(xlUp).Offset(1).Select
　　　　Selection.PasteSpecial Paste:=xlPasteValues
　　End With
　　
　　' ご自分のマクロの最後に次の一行を追加しておいて下さい
　　Call RemoveTask

End Sub

zap35 · Answer

＃０４です。＃０４ではループしちゃいますね。再掲します。Bookを開いた時から一定間隔でマクロを実行します。

Sub Auto_Open()
    TargetTime = Now + TimeValue("00:10:00")  '現在時刻より１０分後
    WaitTime = TimeValue("00:02:00")        'TargetTimeに他処理実行中の時のWaitTime
    Application.OnTime TimeValue(TargetTime), "Macro1", TimeValue(WaitTime)
End Sub

Sub Macro1()
    Range("Q12:S12").Select
    Selection.Copy
    Range("V65536").End(xlUp).Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    
    TargetTime = Now + TimeValue("00:10:00")      　　WaitTime = TimeValue("00:02:00")            　　　Application.OnTime TimeValue(TargetTime), "Macro1", TimeValue(WaitTime)
End Sub

ただし質問者さまのマクロは別のシートを開いているときなどにエラーになる可能性があります。
Worksheets("シート名").Range("Q12:S12").Copy
のようにワークシートを明示した方がよいです

zap35 · Answer

指定時刻に指定するマクロを実行させる命令はあります。詳しくは下記URLを参照して下さい。（著作権があるので引用はしません）

質問者さまが作成したマクロを　Macro1　として
Auto_Open（）
　DO
　　　指定時刻　＝　現在時刻　＋　ｎ分
　　　指定時刻に　Macro1を実行
　LOOP
End sub

とすれば良いと思います

参考URL：http://www.asahi-net.or.jp/~ZN3Y-NGI/YNxv214.html

KenKen_SP · Answer

Application.OnTime じゃダメ？

OnTime メソッド
指定された時刻 (特定の日時、または特定の期間の経過後) にプロシージャを実行します。

tom0120 · Answer

現在の状態では、

その外部のデータを取り込む方法は、
エクセルを開くと、「自動的に、外部のデータを取り込む」ようになってるのでしょうか?

ao777 · Answer

たぶんエクセルVBAにはタイマーコントロールが無かったと思います。
がんばれば作れそうな気もしますが・・
下記のフリーソフトを使うほうが早いです。

参考URL：http://www.vector.co.jp/soft/win95/prog/se286953.html

エクセルで定期的（30分おき）にマクロを実行させる方法は？

えーー。

あ、、、すみません。

Application.OnTime は手軽な反面、結構扱いが難しいかもしれません。

＃０４です。

この回答への補足

指定時刻に指定するマクロを実行させる命令はあります。

Application.OnTime じゃダメ？

この回答への補足

現在の状態では、

たぶんエクセルVBAにはタイマーコントロールが無かったと思います。

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング