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

エクセルにて刻一刻変る外部データ（株価）を表示させています。それを自動で30分置きにデータ蓄積させる方法はありませんか？

現在は自分で作ったキーボードマクロで　時計を見ながらボタンを押し、データを取り込ん出る始末です。

その簡単マクロに「30分置きに実行させる」と云う記述を付け足す程度で自動実行させる事は可能でしょうか？　
当方キーボードマクロでの自動書き込みしか出来ない素人ですが、少々複雑な物であっても頑張ってみるつもりですので、どなたかご教授下さい。

No.1 回答者： ao777 回答日時： 2006/06/16 11:51

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

がんばれば作れそうな気もしますが・・
下記のフリーソフトを使うほうが早いです。

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

この回答へのお礼

ありがとうございました。
僕の質問の件は＃4　＃5サンの回答で解決いたしました。　しかし　フリーソフトを使ってどんどん進化させそうなきもいたします。　ありがとうございました。

お礼日時：2006/06/16 14:36

No.2 回答者： tom0120 回答日時： 2006/06/16 11:59

現在の状態では、

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

No.3 回答者： KenKen_SP 回答日時： 2006/06/16 12:17

Application.OnTime じゃダメ？

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

この回答への補足

早速ありがとうございます。

ON TIME メソッドと云う言葉は　他の質問者様への回答で目にした事はありますが、それが私のパターンで有効なのか、又どのように活用していいのかもまったく分かりません。　
しかし「特定の期間の経過後にプロシージャを実行する」と云うのは凄く良さそうに思えます。
ON TIME メソッド　のやり方はどのようにするのでしょうか？　現在のマクロの書き込み　　

　 Range("Q12:S12").Select
Selection.Copy
Range("V65536").End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, 　　Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

こんな感じですが、これに　on time メソッドをどう加えたら宜しいのでしょうか？

補足日時：2006/06/16 12:45

No.4 回答者： zap35 回答日時： 2006/06/16 13:06

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

詳しくは下記URLを参照して下さい。（著作権があるので引用はしません）

質問者さまが作成したマクロを　Macro1　として
Auto_Open（）
　DO
　　　指定時刻　＝　現在時刻　＋　ｎ分
　　　指定時刻に　Macro1を実行
　LOOP
End sub

とすれば良いと思います

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

No.5 回答者： zap35 回答日時： 2006/06/16 13:45

＃０４です。

＃０４ではループしちゃいますね。再掲します。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
のようにワークシートを明示した方がよいです

この回答への補足

ありがとうございます。
早速試してみます。
後ほど結果をご報告いたします。

補足日時：2006/06/16 14:08

この回答へのお礼

ばっちり上手く行きそうです。
現在仕事中なので終わってからみっちりと検証しようと思いますが、今の所想像通りの動きをしています。
本当にありがとうございました。

お礼日時：2006/06/16 14:37

No.6 回答者： KenKen_SP 回答日時： 2006/06/16 14:53

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

この回答へのお礼

ありがとうございます。
これはそのまま貼り付けて使えるものなのでしょうか？　これが理解できたら本当に面白そうです。

自宅に戻って試してみます
ありがとうございました。

お礼日時：2006/06/16 17:39

No.7 回答者： KenKen_SP 回答日時： 2006/06/16 14:58

あ、、、すみません。

Setting 欄、コメントと全然違いますね。
30秒間を10秒間隔でテストしたときのものです。
直すの忘れました。

適切に書き直して下さい。

No.8 ベストアンサー 回答者： KenKen_SP 回答日時： 2006/06/17 00:14

えーー。

。実際に使うなら、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

この回答へのお礼

ありがとうございました。
頂いた記述を少々加工して月曜の値動きに使ってみましたら、ばっちり動いて非常に満足な結果です。
これとっても良さそうです。
本当にありがとうございました。

お礼日時：2006/06/19 09:24