「教えて!ピックアップ」リリース!

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

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

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

A 回答 (8件)

えーー。

。実際に使うなら、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
    • good
    • 3
この回答へのお礼

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

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

あ、、、すみません。



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

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

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

実行
予約のキャンセルとか、2重予約のトラップとか。

その辺も含めてコーディングしてありますが、ザッと作ったので穴があるかも
しれません。

実行予約の 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
    • good
    • 1
この回答へのお礼

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

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

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

#04です。

#04ではループしちゃいますね。再掲します。Bookを開いた時から一定間隔でマクロを実行します。

Sub Auto_Open()
TargetTime = Now + TimeValue("00:10:00") '現在時刻より10分後
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
    • good
    • 1
この回答へのお礼

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

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

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

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

質問者さまが作成したマクロを Macro1 として
Auto_Open()
 DO
   指定時刻 = 現在時刻 + n分
   指定時刻に Macro1を実行
 LOOP
End sub

とすれば良いと思います

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

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
    • good
    • 0

現在の状態では、



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

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


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

参考URL:http://www.vector.co.jp/soft/win95/prog/se286953 …
    • good
    • 0
この回答へのお礼

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

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

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

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


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

人気Q&Aランキング