エクセルのVBAについて

このQ&Aのポイント
  • エクセルのVBAの使い方と、他人の書いたVBAを使ってマクロを自動実行する方法について紹介します。
  • 午前8時00から午前2時00まで5分おきに動かすVBAが正常に動かない場合の対処法を教えてください。
  • 実行予約を設定するVBAのプログラムコードを紹介します。
回答を見る
  • ベストアンサー

エクセルのVBAについて。

エクセルのVBAのことは全く分かりませんが、他人の書いたVBAを使わせてもらい、自動で一定の間隔ごとに私が記録したマクロを動すようにしています。 そこで質問なのですが、午前8時00から、午前2時00まで5分おきに動かしたいのですが、日付が変わると動作しなくなってしまいます。どこが悪いのでしょうか? 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("08:00:00") ' 開始時刻 datEnd = TimeValue("02:00:00") ' 終了時刻 datInterval = TimeValue("00:05: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

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

  • ベストアンサー
  • KURUMITO
  • ベストアンサー率42% (1835/4283)
回答No.2

datBigin やdatEndなどをDateステートメントとしているにもかかわらず datBigin = TimeValue("08:00:00") ' 開始時刻 datEnd = TimeValue("02:00:00") ' 終了時刻 のような使い方になっています。 このような使い方に問題が有るでしょう。 timBiginやtimEndなどを考えることが必要でしょう。

syamu124
質問者

お礼

ありがとうございます。色々書き換えないといけないということですね。 timBiginなどのコードをグーグル検索してもヒットしないので、なかなかにむずかしいですね。

その他の回答 (1)

  • osamuy
  • ベストアンサー率42% (1231/2878)
回答No.1

> ' メイン部分 > For i = datBigin To datEnd Step datInterval > (略) > Next i ――を見る限り、1日分しか実行予約しなさそうな。 次の日になったら、実行予約しなおすようにしてみるか、実行時間の処理の仕方を変えてみるとか。

syamu124
質問者

お礼

ありがとうございます。マクロを使い始めたのが一昨日からなもので、むずかしいです。

関連するQ&A

  • 外部データの保存

    http://www.bloomberg.co.jp/markets/commodities/cfutures.html 上記のサイトをエクセルのWebクリエで取り込んで、2分おきにっ更新していますが、そのデータをすべて保存したいです。 そこで、サイトにあるコードを使いました。 1、50秒おきにデータをほかのセルにコピー 2、コピーした先の数値が、(コピー元の)時間と時価が同じなら、コピーしない。 3、コピーした先が、(コピー元の)時間と時価が違うなら、1つ下にズラしてコピー 4、・・・・ としていますが、実行してみると、数値のコピーはされますが、 「Book1の一定間隔で実行するマクロを実行できません。」 となります。 どうしてでしょうか。 Option Explicit Dim 開始時刻, 終了時刻, インターバル, 反復時刻 Public Line As Integer '--------------------------------------------------------------------------------- Sub 開始時刻から終了時刻まで一定間隔でマクロを実行する() 開始時刻 = TimeValue("09:00:00") 終了時刻 = TimeValue("23:00:00") インターバル = TimeValue("00:00:50") Application.OnTime 開始時刻, "一定間隔で実行するマクロ" End Sub '--------------------------------------------------------------------------------- Sub 一定間隔で実行するマクロ() If TimeValue(Now) >= 終了時刻 Then '終了時刻になったら終わる MsgBox "終了時刻になりました。" Exit Sub End If Call 必要な作業を行うマクロ 反復時刻 = TimeValue(Now) + インターバル Application.OnTime 反復時刻, "一定間隔で実行するマクロ" End Sub '--------------------------------------------------------------------------------- Sub 必要な作業を行うマクロ() Dim flag As Integer Line = 11 If Cells(Line, 2).Value = Cells(2, 2).Value And Cells(Line, 1).Value = Cells(2, 5).Value Then Line = Line + 1 Cells(Line, 2).Value = Cells(2, 2).Value Cells(Line, 1).Value = Cells(2, 5).Value Else Cells(Line, 2).Value = Cells(2, 2).Value Cells(Line, 1).Value = Cells(2, 5).Value End If End Sub

  • エクセル 時間の合成

    インターバル = TimeValue("00:50:00") 早速ですが インターバル = TimeValue("00:50:00") Debug.Print Now + インターバル これは エラーになりません。 しかし If Format(Now, "hh:mm:ss") < Format("3:00:00", "hh:mm:ss") Then 終了時刻 = Format(Now, "yyyy/mm/dd") & " " & TimeValue("3:02:00") Else 終了時刻 = Format(DateAdd("d", 1, Now), "yyyy/mm/dd") & " " & TimeValue("3:02:00") End If Debug.Print 終了時刻 + インターバル これは、型が合わないエラーです。 終了時刻は 文字列的に合成されただけ・・・だろうと 推察するのですが では、「終了時刻 + インターバル」 が 可能な終了時刻は どうして 作ればいいのでしょうか?

  • Excel2003 VBAでタイマーを組んでマクロを走らせたいのですが

    Excel2003 VBAでタイマーを組んでマクロを走らせたいのですが、以下のエラーメッセージが出ました。 マクロ "C:\aaa\Timer.xls'!Record1'が見つかりません。 マクロは、Timer.xlsブックのThisWorkbookに記述しています。 ---------------------------------------------------------------------- Sub timer1() 指定時刻 = TimeValue("09:00:00") 終了時刻 = TimeValue("11:00:00") Application.OnTime 指定時刻, "Record1" End Sub ---------------------------------------------------------------------- Sub Record1() Dim sh1, sh2 If TimeValue(Now) >= 終了時刻 Then '終了時刻になら終わる MsgBox "終了時刻になりました。" Application.CutCopyMode = False Exit Sub End If Set sh1 = Worksheets("1") Set sh2 = Worksheets("2") sh1.range("G5:G506").Copy 'コピー sh2.range("Q5:Q506").PasteSpecial Paste:=xlValues Selection.Offset(0, 2).Select '2行ずらす 指定時刻 = Now + TimeValue("00時05分00秒") '5分後 Application.OnTime 指定時刻, "Record1" End Sub ---------------------------------------------------------------------- どこを直せばよろしいのでしょうか? よろしくお願いします。

  • 時間帯の識別がしたいのですが…

    呼出されて勤務した時間帯を管理したいのですが selectcase文で18:00から2:00まで勤務したら『準夜-深夜』と表記したいのですが『型が合いません』とエラーが出ます マクロは我流で勉強中なのでよろしくお願いします Dim 開始時間 As Date, 終了時間 As Date Dim 開始時間帯 As String, 終了時間帯 As String, 業務時間帯 As String Private Sub 業務ステータス() 開始時間 = TimeValue(開始時間TextBox.Text) 終了時間 = TimeValue(終了時間TextBox.Text) Select Case 開始時間 Case 開始時間 > TimeValue("8:29") And 開始時間 < TimeValue("17:00"): 開始時間帯 = "日勤" Case 開始時間 > TimeValue("16:59") And 開始時間 < TimeValue("24:00"): 開始時間帯 = "準夜" Case 開始時間 > TimeValue("0:00") And 開始時間 < TimeValue("8:30"): 開始時間帯 = "深夜" Case 開始時間 = TimeValue("0:00"): 開始時間帯 = "深夜" End Select Select Case 終了時間 Case 終了時間 > TimeValue("8:29") And 終了時間 < TimeValue("17:00"): 終了時間帯 = "日勤" Case 終了時間 > TimeValue("16:59") And 終了時間 < TimeValue("24:00"): 終了時間帯 = "準夜" Case 終了時間 > TimeValue("0:00") And 終了時間 < TimeValue("8:30"): 終了時間帯 = "深夜" Case 終了時間 = TimeValue("0:00"): 終了時間帯 = "深夜" End Select If 開始時間帯 = 終了時間帯 Then 業務時間帯 = 開始時間帯 Else 業務時間帯 = 開始時間帯 & "-" & 終了時間帯 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 がマーカーで引かれます 一応本通りには打ったと思うのですが、、、。 どこが間違えているか教えてください

  • エクセルVBAについて

    VBAを勉強しているものです。 添付資料のようなグラフを作っております。 ############################################################### Sub 時間グラフ作成() Dim 開始 As Date Dim 終了 As Date Dim 開始経過時間 As Long, 終了経過時間 As Long Dim 開始目盛 As Long, 終了目盛 As Long 開始 = Worksheets("(1)(1)(1)(1)(1)").Range("F2").Value 開始経過時間 = DateDiff("n", CDate("9:00"), 開始) 開始目盛 = Int(開始経過時間 / 5) Worksheets("(2)(2)(2)(2)").Range("H2").Offset(, 開始目盛).Interior.ColorIndex = 8 If 開始 <= "11:00" And 終了 >= "12:00" Then 終了 = Worksheets("(1)(1)(1)(1)(1)").Range("G2").Value 終了経過時間 = DateDiff("n", CDate("9:00"), 終了) 終了目盛 = Int(終了経過時間 / 5) Worksheets("(2)(2)(2)(2)").Range("H2").Offset(, 終了目盛 - 12).Interior.ColorIndex = 8 Range(Range("H2").Offset(, 開始目盛), Range("H2").Offset(, 終了目盛 - 12)).Interior.ColorIndex = 8 Else 終了 = Worksheets("(1)(1)(1)(1)(1)").Range("G2").Value 終了経過時間 = DateDiff("n", CDate("9:00"), 終了) 終了目盛 = Int(終了経過時間 / 5) Worksheets("(2)(2)(2)(2)").Range("H2").Offset(, 終了目盛).Interior.ColorIndex = 8 Range(Range("H2").Offset(, 開始目盛), Range("H2").Offset(, 終了目盛)).Interior.ColorIndex = 8 End If End Sub ############################################################### 休憩時間のIfの処理がうまくいかなくて困っています・・・。 &とAndで変わったり(どちらもうまくいかず)、 ()をつけたりしても変わらず、そもそも根本的に 間違っているのか・・・。 よろしくお願いいたします。 (グラフの繰り返しの処理は未だ考え中で触っておりません)

  • vba 初心者

    Dim a As Integer Dim inbox As String Dim Localpath As Variant Dim c As Range, myFadd As String Dim flag As Variant Dim MyShell As Object Dim Mysh As String Dim newHour As Variant Dim newMinute As Variant Dim newSecond As Variant Dim waitTime As Variant Localpath = ThisWorkbook.Path a = 1 inbox = InputBox("番号") Do If inbox = Empty Then Exit Sub End If If inbox = Cells(a, 1) Then MsgBox ("あります") Exit Do Else a = a + 1 ElseIf Cells(a, 1) <> inbox Then MsgBox ("ない") End If Loop Set MyShell = CreateObject("WScript.Shell") MyShell.Run ("AcroRd32.exe /n") MyShell.Run ("AcroRd32.exe /p") & Localpath & "\" & Myfile & ".pdf" newHour = Hour(Now()) newMinute = Minute(Now()) newSecond = Second(Now()) + 10 waitTime = TimeSerial(newHour, newMinute, newSecond) Application.Wait waitTime Application.SendKeys "{Enter}", True '次の使用例は、10 秒を過ぎるとメッセージを表示します。 If Application.Wait(Now + TimeValue("0:00:10")) Then MsgBox "時間が過ぎました。" End If End Sub ExcelからPDFファイルを検索して印刷したいのですが、 見よう見まねで作ってみたもののエラーが出てしまってよく分かりません。 指摘できるところご指導よろしくお願いします。

  • マクロ エクセル2003 Sort

    いつも回答して頂きとても感謝しています。 エクセル2010で作成した記述を、ほぼそのままエクセル2003に書き写し実行した所、Sortの箇所でエラーが発生しました。 これはLoop中に実行しており、Loop1回目はエラーは発生しませんでしたが、Loop2回目ではエラーが発生しました。 確認の為、エクセル2010で実行した所、エラーは発生しませんでした。 いまいち原因が分からないので、間違いや抜けている箇所があれば教えて下さい。宜しくお願い致します。 問題のマクロの記述を一部下記に記載。 ※問題の記述の箇所は一番下にあります。 Dim 開始1 As Date, 開始2 As Date, 開始3 As Date Dim 終了1 As Date, 終了2 As Date Dim 最初 As Date, 最後 As Date Dim Path1 As String, Path2 As String Dim Buf1 As String, Buf2 As String Dim File As String Dim 日付c As Long Dim 項目c1 As Long, 項目c2 As Long Dim c As Long Dim MaxR As Long, MaxC As Long Dim wb As Workbook Dim ws1 As Worksheet Dim ws2 As Worksheet On Error GoTo errhandle 開始1 = InputBox("yyyy/mm/dd", "開始日設定画面") On Error GoTo 0 If 開始1 > Date Then MsgBox "現在の日付より開始日の方が新しい為検索出来ません。" Exit Sub End If On Error GoTo errhandle 終了1 = InputBox("yyyy/mm/dd", "終了日設定画面") On Error GoTo 0 If 終了1 > Date Then MsgBox "現在の日付より終了の日付の方が新しい為検索出来ません。" Exit Sub ElseIf 開始1 >= 終了1 Then MsgBox "現在の日付より終了の日付の方が新しい為検索出来ません。" Exit Sub End If 開始2 = 開始1 If Day(開始1) >= Day(終了1) Then 終了2 = DateAdd("m", 1, 終了1) Else 終了2 = 終了1 End If Set ws2 = Workbooks("アラーム収集").Worksheets("アラーム履歴一覧") MaxR = ws2.Cells(Rows.Count, 2).End(xlUp).Row If ws2.Cells(3, 3) <> "" Then ws2.Rows("3:" & MaxR).ClearContents End If Do Until 開始2 >= 終了2 File = "aaa " & Format(開始2, "yyyy年m月") Path1 = "C:\Users\Owner\Documents\" Path2 = "C:\Users\Owner\Documents\" & Format(開始2, "yyyy年") & "\" If Dir(Path1 & File & ".xlsx") <> "" Then Buf1 = Dir(Path1 & File & ".xlsx") For Each wb In Workbooks If wb.Name = Buf1 Then MsgBox Buf1 & vbCrLf & "はすでに開いています", vbExclamation Exit Sub End If Next wb Workbooks.Open Filename:=Path1 & File & ".xlsx" ElseIf Dir(Path2 & File & ".xlsx") <> "" Then Buf2 = Dir(Path2 & File & ".xlsx") For Each wb In Workbooks If wb.Name = Buf2 Then MsgBox Buf2 & vbCrLf & "はすでに開いています", vbExclamation Exit Sub End If Next wb Workbooks.Open Filename:=Path2 & File & ".xlsx" Else MsgBox (File & "が存在しません!!") Exit Sub End If Set ws1 = Workbooks(File).Worksheets("アラーム履歴") If 開始1 = 開始2 Then 最初 = 開始1 Else 最初 = Format(開始2, "yyyy/m/1") End If If 終了1 < Format(DateAdd("m", 1, 開始2), "yyyy/m/d") Then 最後 = 終了1 Else 開始3 = Format(開始2, "yyyy/m/1") 最後 = DateAdd("d", -1, DateAdd("m", 1, 開始3)) End If With ws1 MaxR = .Cells(Rows.Count, 2).End(xlUp).Row MaxC = .Cells(2, Columns.Count).End(xlToLeft).Column 日付c = .Rows(2).Find(what:="発生日時", LookIn:=xlValues, _ lookat:=xlWhole, searchorder:=xlByColumns, _ searchdirection:=xlNext).Column .Range(.Cells(2, 日付c), .Cells(MaxR, MaxC)).Sort _             ←  問題の箇所 Key1:=.Cells(2, 日付c), order1:=xlAscending, Header:=xlYes

  • エクセルVBA 時刻の計算 テキストボックス

    お知恵をお貸しください。 入力を簡単にするためのユーザーフォームを作っています。 開始時間(txt開始)に「14:00」 終了時間(txt終了)に「19:00」と入力すると 時間(txt時間)は「5:00」(19:00-14:00=5:00) 通常(8:00~18..00)に「4」(4:00*24) 時間外(6:00~8:00、18:00~22:00)に「1」(1:00*24) 深夜(22:00~6:00) と表示させたく思います。 通常、時間外、深夜のテキストボックスに表示することができません。 よろしくお願いします。 Private Sub txt時間_Exit(ByVal Cancel As MSForms.ReturnBoolean) If txt開始 > TimeValue("8:00") And txt開始 < TimeValue("18:00") Then txt通常.Text = TimeValue(txt時間.Value) * 24 End If End Sub Private Sub txt終了_Exit(ByVal Cancel As MSForms.ReturnBoolean) txt時間.Value = Format((TimeValue(txt終了.Text) - TimeValue(txt開始.Text)), "h:mm") End Sub

  • vba初心者

    いつもお世話様です。 A列にあらかじめデータを入れといてinboxでデータを検索してもしあったらPDFファイルを開いて印刷でもしデータがなかったらinboxに戻るかたちにしたいんですけど、do...loopの使い方が分からないのと、デバックがでてしまってどう直せばいいかわかりません。サンプルコードがあれば助かります。よろしくお願いします。 Dim a As Integer Dim inbox As String Dim Localpath As Variant Dim c As Range, myFadd As String Dim flag As Variant Dim MyShell As Object Dim Mysh As String Dim newHour As Variant Dim newMinute As Variant Dim newSecond As Variant Dim waitTime As Variant Localpath = ThisWorkbook.Path a = 1 inbox = InputBox("番号") Do If inbox = Empty Then Exit Sub End If If inbox = Cells(a, 1) Then MsgBox ("あります") Exit Do Else a = a + 1 ←ここでデバックがでてしまいます。 ElseIf Cells(a, 1) <> inbox Then MsgBox ("ない") End If Loop Set MyShell = CreateObject("WScript.Shell") MyShell.Run ("AcroRd32.exe /n") MyShell.Run ("AcroRd32.exe /p") & Localpath & "\" & Myfile & ".pdf" newHour = Hour(Now()) newMinute = Minute(Now()) newSecond = Second(Now()) + 10 waitTime = TimeSerial(newHour, newMinute, newSecond) Application.Wait waitTime Application.SendKeys "{Enter}", True '次の使用例は、10 秒を過ぎるとメッセージを表示します。 If Application.Wait(Now + TimeValue("0:00:10")) Then MsgBox "時間が過ぎました。" End If End Sub