エクセルマクロでLoopを使うと応答なしになる理由は？

前へ 次へ
このQ&Aのポイント
  • エクセル２０１０でタイマーを作って作動させると、必ず応答なしになることがあります。
  • Sleeepを使用しても応答なしになる場合があります。
  • 応答なしになる理由は、無限ループが発生しているためです。
回答を見る
  • ベストアンサー

エクセルのマクロでLoopを使うと応答なしになり…

エクセル２０１０でタイマーを作って作動させるとかならず応答なしになります。Ｓｌｅｅｐも使ったのですが応答なしになりました。そうなった理由をできれば教えてください。よろしくお願いします マクロ Sub macro() Dim EndTime As Long Dim PassTime As Long EndTime = Timer + Range("c6").Value * 60 + Range("E6").Value Do PassTime = Timer Range("c6").Value = (EndTime - PassTime) \ 60 '分 Range("e6").Value = (EndTime - PassTime) Mod 60 '秒 Loop Until EndTime - PassTime <= 0 Beep MsgBox "時間だよ" End Sub

  • riifu
  • お礼率75% (9/12)

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

  • ベストアンサー
  • mitarashi
  • ベストアンサー率59% (574/965)
回答No.2

xl2010で試しましたが、問題なく動きましたよ。 （但し、１分数十秒迄しか試しておりませんが） DoEventsを入れないと、画面の更新がなされない事がありますが、 それを応答無しと勘違いされている事はありませんか？ これだけのためにPCを100%占有しても仕方が無いので、Sleepは入れた方が良いでしょう。 Sub macro() Dim EndTime As Long Dim PassTime As Long EndTime = Timer + Range("c6").Value * 60 + Range("E6").Value Do PassTime = Timer Range("c6").Value = (EndTime - PassTime) \ 60 '分 Range("e6").Value = (EndTime - PassTime) Mod 60 '秒 DoEvents: DoEvents: DoEvents Loop Until EndTime - PassTime <= 0 Beep MsgBox "時間だよ" End Sub

riifu
質問者

お礼

上記のコードで試してみたらできました！ありがとうございます

その他の回答 (1)

回答No.1

ブレイクしてる？ 例えば、「Do」でブレイクするると、時空が歪んでしまって、「(EndTime - PassTime)」は最早マイナスの世界になっている、、、 が、永久ループにはならないのでは？？

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • Excelでタイマーの一時停止するボタンのコードは

    Excelでタイマーを作ったけど、一時停止できないとやっぱ面白くないと気づき、一時停止機能を付け加えたいが、まだ勉強し始めたばかりなので自分でコードが書けません。 なので、一時停止させるコードがわかる方教えてください。 ＜タイマーのコード＞ Sub タイマー() Dim EndTime Dim PassTime EndTime = Timer + Range("D5").Value * 60 + Range("F5").Value Do PassTime = Timer Range("D5").Value = (EndTime - PassTime) \ 60 '分 Range("F5").Value = (EndTime - PassTime) Mod 60 '秒 DoEvents Loop Until EndTime - PassTime <= 0 Beep MsgBox "時間です" End Sub

  • Excelのマクロについての質問です。マクロに関しては初心者です。

    Excelのマクロについての質問です。マクロに関しては初心者です。 温度を計測する実験をしています。sheet1に計測している数値が更新されていってどんどん書き込まれている状況です。 Dim fStop As Boolean 'グローバル変数を宣言 Private Sub Command1_Click() ' ' Macro1 Macro ' ' Dim iRows As Integer Dim sRows As String Dim i As Integer Dim tm As Single fStop = Fal For i = 1 To 500 Cells(1, 1) = i tm = Timer() + 5 Do DoEvents Loop While Timer() < tm ' 最終行の調査: iRows = Worksheets("Sheet1").UsedRange.Rows.Count ' 最終行をシート3にコピー Worksheets("Sheet1").Rows(iRows).Copy Destination:=Worksheets("Sheet4").Range("1:1") ' CH1 の最新データをシート3にコピー Worksheets("Sheet3").Range("B9").Value = Worksheets("Sheet1").Cells(iRows, 3).Value ' CH2 の最新データをシート3にコピー Worksheets("Sheet3").Range("C9").Value = Worksheets("Sheet1").Cells(iRows, 4).Value ' CH3 の最新データをシート3にコピー Worksheets("Sheet3").Range("D9").Value = Worksheets("Sheet1").Cells(iRows, 5).Value Next i End Sub Private Sub Command2_Click() fStop = True End Sub 上記のプログラムを作り、sheet1に書き込まれていってる数値の一番新しい数値のみをsheet3の特定のセルの場所に更新されていくように作りました。（コマンドボタン１で計測を開始、コマンドボタン２で計測終了） しかし計測する場所が増えるにつれて下記の部分のプログラムを増やさなければいけません。このプログラムを一まとめにして、指定されたsheet3のセルに書きこまれるようにしたいのですが、どのようなプログラムを加えればいいのでしょうか？Excelのバージョンは２００３です。 ' CH1 の最新データをシート3にコピー Worksheets("Sheet3").Range("B9").Value = Worksheets("Sheet1").Cells(iRows, 3).Value ' CH2 の最新データをシート3にコピー Worksheets("Sheet3").Range("C9").Value = Worksheets("Sheet1").Cells(iRows, 4).Value ' CH3 の最新データをシート3にコピー Worksheets("Sheet3").Range("D9").Value = Worksheets("Sheet1").Cells(iRows, 5).Value

  • EXCEL マクロ　条件によるセルの色付け

    お世話になります。 マクロは初心者です。 C列の数値1～6によって、E列に色付けしたく、ネットで色々検索して、 下記のように組んだのですがコマンドボタンクリックでは上手く動かない のですが、どのように修正すればよいのでしょうか。教えて下さい。 宜しくお願いします。 Private Sub CommandButton4_Click() Dim i As Range Dim r As Range Dim c As Range Dim myColor As Long Set i = Worksheets("マスタ").Range("C:C") Set r = Worksheets("マスタ").Range("E:E") If Intersect(Target, i) Is Nothing Then Exit Sub For Each c In Intersect(Target, i) With c Select Case .Value Case "1" myColor = 22 Case "2" myColor = 44 Case "3" myColor = 6 Case "4" myColor = 43 Case "5" myColor = 41 Case "6" myColor = 24 Case Else myColor = xlColorIndexNone End Select Intersect(c.EntireRow, r).Interior.ColorIndex = myColor End With Next End Sub

  • エクセル 2010 マクロ 検索

    http://okwave.jp/qa/q8562170.html 上記質問に追加です。 ※1 'D,E,F,G,H,I,K を検索してD,E,F,G,H,I に検索対象があった時 E,F,G,H,Iのいずれかだったら左横列の上に向かって (EならD　、FならE ・・・という具合に) 何か入力されているセルのM列の191000####をmsgboxで表示させたいです。 (画 F11セル(A-1)が検索ヒットした場合E9セル(R-01)を辿り、 その行のM列のセル(191000####)をmsgboxで表示 ※2 但し、検索結果がD列のデータだった時、その行のM列が191000####だった場合 M列の191000####をmsgboxで表示させたいです。 (画 D25セル(Y-1)対象の時) ※3 また、検索結果がD列のデータだった時、その行のM列が191000####以外だった場合 (空白だったり191000####以外の場合) M列の一番上の191000####をmsgboxで 191000####&「これは例外です」と表示させたいです。 (画 D24セル (X-1)対象の時) 現在のコードは下記のとおりです。 Sheet1に Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address <> "$A$3" Then Exit Sub Call 検索 Range("A1:A2").Clear Range("A1").Activate End Sub 標準モジュールに Sub 検索() 　Dim Ws1 As Worksheet, Ws2 As Worksheet 　Dim strKey As Variant 　Dim s As String 　Dim c As Range, bln As Boolean 　Dim rng1 As Range 　Dim cnt As Long 　 　Set Ws1 = Sheet1 　Set Ws2 = Sheet2 　 　Ws1.Select 　 　With Ws2 　　strKey = Application.Transpose(.Range("A1").Resize(2).Value) 　　strKey = Join(strKey, "") 　End With 　 　If Trim(strKey) = "" Then MsgBox "検索キーが空です", vbCritical: Exit Sub 　 　 　With Ws1 　　Set rng1 = .Range("K2", .Cells(Rows.Count, "K").End(xlUp)) 　　For Each c In rng1.Offset(, -10) 　　　 'D,E,F,G,H,I,Kを検索 　　　s = c.Offset(0, 3).Value & c.Offset(0, 4).Value & c.Offset(0, 5).Value & c.Offset(0, 6).Value & c.Offset(0, 7).Value & c.Offset(0, 8).Value & c.Offset(0, 10).Value & 　　　 　　　If StrComp(s, strKey, vbTextCompare) = 0 And c.Offset(0, 2).Value = "" Then 　　　　c.End(xlToRight).Activate c.Offset(0, 2).Value = Date 　　　　 　　　　c.Resize(1, 14).Interior.ColorIndex = 6 　　　　bln = True 　　　　Exit For 　　　End If 　　Next c 　　 　　If Not bln Then 　　　Ws2.Select 　　　MsgBox "リストに存在しません", vbExclamation, "NotFound" 　　Else '加える 　　　Call ReSearch(Ws1.Range("M2"), c.Row) 　　　'再設定 　　　Set rng1 = .Range("K6", .Cells(Rows.Count, "K").End(xlUp)) 　　　MsgBox "残り" & DoubleCountBlank(rng1.Offset(, -8), rng1) & "品目です。", vbInformation 　　End If 　End With 　Application.Goto Ws2.Range("A1"), True End Sub Sub ReSearch(Rng As Range, j As Long) '最初のセル, 終わりの行数 Dim i As Long Dim Ws As Worksheet With Rng.Parent For i = j To Rng.Row Step -1 If CStr(.Cells(i, Rng.Column).Value) Like "191000####" Then MsgBox "指図番号 " & vbCrLf & CStr(.Cells(i, Rng.Column).Value) & " の部品です" Exit For End If Next i End With End Sub Function DoubleCountBlank(rng1 As Range, rng2 As Range) '横並びのセルのブランクをカウントする (セル範囲1 , セル範囲2) 　Dim i As Long 　Dim cnt As Long 　For i = 1 To rng1.Rows.Count 　　If VarType(rng2.Cells(i, 1)) = vbDouble Then 　　　If rng1.Cells(i, 1).Value = "" And rng2.Cells(i, 1).Value <> 0 Then 　　　　cnt = cnt + 1 　　　End If 　　End If 　Next i 　DoubleCountBlank = cnt End Function 宜しくお願い致します。

  • マクロが思うように動きません

    エクセル2007です。 初心者です。 マクロが思うように動きません。 指定のセルが空白の場合、msgboxを表示して、処理を抜ける 空白でない場合は、処理をつつける。 と言う事をしたいです。 with～の後が問題だと思うのですが・・ Sub 受注履歴書き込み() Dim ws01 As Worksheet, ws02 As Worksheet Dim r As Long, c As Integer, tmp As Long Set ws01 = Worksheets("受注書") Set ws02 = Worksheets("受注履歴") ws01.Activate With ws01 If .Range("C2").Value = "" _ And .Range("M2").Value = "" _ And .Range("M11").Value = "" _ And Worksheets("粗利報告書").Range("D3").Value = "" Then MsgBox "受注Noが空白です。処理を中止します。" Exit Sub ws02.Cells(r, 1).Value = .Range("C2").Value ' 受注No ws02.Cells(r, 9).Value = .Range("A40").Value ' 備考 ws02.Activate End If End With End Sub 採点願えますでしょうか？ 宜しくお願い致します。

  • エクセルの簡単なマクロ機能を追加したいのです

    既存のエクセルマクロ（Sub チェック()以下です）に下記の内容のマクロを付け足したいです。 教えていただけないでしょうか。 付け足したい条件です： 　Sheet2のC列に　0　 があれば 　Sheet1のB列に　愛 と（[太字]でセルの背景色を[灰色25%]にして）入れたいです 恐れ入りますがご存じの方がいらっしゃりましたら教えていただきたく何卒よろしくお願いいたします。 ----------------------------------------------- Sub チェック() Dim Ws1 As Worksheet Dim Ws2 As Worksheet Dim myRange1 As Range Dim myRange2 As Range Dim c1 As Range Dim c2 As Range Dim myCt As Long Set Ws1 = Worksheets("Sheet1") Set Ws2 = Worksheets("Sheet2") Set myRange1 = Ws1.Range("A1", Ws1.Cells(Rows.Count, "A").End(xlUp)) Set myRange2 = Ws2.Range("A1", Ws2.Cells(Rows.Count, "A").End(xlUp)) For Each c1 In myRange1 myCt = 0 For Each c2 In myRange2 If c2.Value = c1.Value Then If c2.Offset(, 1).Value = "" Then c1.Offset(, 1).Interior.ColorIndex = 3 Else c1.Offset(, 1).Value = c2.Offset(, 1).Value End If myCt = myCt + 1 End If Next c2 If myCt > 1 Then c1.Offset(, 1).Interior.ColorIndex = 10 Next c1 Set Ws1 = Nothing Set Ws2 = Nothing Set myRange1 = Nothing Set myRange2 = Nothing End Sub

  • エクセル　マクロ　検索

    お世話になります。 範囲がA2からK221までの表があります。 検索して検索されたセルの左のセルを表示するマクロを組みたいのですが、検索する文字（数値）はE1に、検索結果はK1に表示するようにするにはどのようにしたらいいでしょうか？ Sub FIND_DATA1() ' FIND_DATA1 Macro ' マクロ記録日 : 2006/9/1 ユーザー名 : ' Cells.Find(What:=Range("E1").Value, After:=ActiveCell, lookAt:=xlWhole).Activate End Sub Sub Data_Find3() Dim 対象セル As Range Dim 最初のセル番地 As String Dim 検索件数 As Long Cells.Interior.ColorIndex = xlNone If Range("E1").Value = "" Then Exit Sub End If Set 対象セル = Cells.Find(What:=Range("E1").Value, After:=ActiveCell, lookAt:=xlWhole) 最初のセル番地 = 対象セル.Address Do 対象セル.Interior.ColorIndex = 37 検索件数 = 検索件数 + 1 Set 対象セル = Cells.FindNext(対象セル) Loop While 対象セル.Address <> 最初のセル番地 MsgBox "検索件数は" & 検索件数 - 1 & " 件です" End Sub 本を見たり調べたりでここまでできたんですがこれだと検索件数、検索結果が色付きになるだけで使い勝手がいまいちです。 よろしくお願いします。

  • エクセルＶＢＡを教えて下さい

    エクセルの表で －ＡＢ Ｃ Ｄ Ｅ Ｆ １年月－－1801 ２－－－－－－ ３－－－－－－ ４－－－－－－ （－）は空欄でセルＥ１＝１８、Ｆ１＝１とします。 コントロールボックスをつかって Private Sub Command登録_Click() Dim d1 As Long Dim d2 As Long Dim ret As Variant Dim FindValue As String Dim TotalAddress As String If Range("E1").Value = "" Or Range("F1").Value = "" Then MsgBox "該当する場所にデータが入っていません。", vbCritical Exit Sub End If d1 = Range("A65536").End(xlUp).Offset(1).Row d2 = Range("B65536").End(xlUp).Offset(1).Row FindValue = """" & Range("E1").Value & Range("F1").Value & """" TotalAddress = Range("A1").Resize(d1).Address & "&" & Range("B1").Resize(d1).Address ret = Evaluate("MATCH(" & FindValue & "," & TotalAddress & ",0)") If IsError(ret) Then Cells(d1, 1) = Range("E1").Value Cells(d2, 2) = Range("F1").Value Else MsgBox "既に同じ組み合せがあります。", vbInformation End If End Sub というものを作ったのですが、Ｅ１＝１８、Ｆ１＝１及びコマンドボタンを別シートに作成し、上記の表への登録をできるようにしたいのですが、なにかいい方法はありませんか？

  • エクセル・マクロについて

    以下のマクロはセルA1～A100にて1が表示されると音(Beep)が鳴るというものです。これを下記(1)(2)ができるように修正したいです。ご教示お願いします。 (1)音(Beep)と同時にセルA1～A100のどのセルにて1が表示されたかわかるようにしたいです。メッセージボックスなどにて表示させるにはどのように修正すれば良いですか？ 例.A12で1が表示されたら音が鳴りメッセージボックスにA12と表示される。続いてA55で1が表示されたら音が鳴りメッセージボックスにA55と表示される、みたいに・・・。 (2)音がBeepですが、これ以外に音を変更させることは可能ですか？ 音は何でもいいです。（ピーとかポロンなど） ※このマクロはシート右クリック→コードの表示で開いた所に打ち込んでいます。 Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Variant Dim r As Range Dim c As Variant On Error GoTo EndLine i = Null Set r = Target.DirectDependents For Each c In Range("A1:A100").Cells If Not Intersect(r, c) Is Nothing Then i = c.Value Exit For End If Next c Application.EnableEvents = False If i = 1 Then Beep End If Set r = Nothing EndLine: Application.EnableEvents = True

  • マクロについて

    マクロでデータをクリアするコマンドボタンを作りました。でも、計算の答えがでなくなりました。 例えば、 A1：A10までの情報はクリアになります。 答えの“=SUM(A1:A10)”というCセルだけが前の情報のままになります。（Cセルはマクロに登録していません。） 全くのど素人で、マクロの登録も他の書類からコピーしてセルだけ変えました。 マクロの内容は、下記の通りです。 Sub Macro1() ' ' Macro1 Macro ' マクロ記録日 ' Sub allclear() Application.Calculation = xlManual Range("D4").Value = "" Range("B6").Value = "" Range("B8").Value = "" Range("E11").Value = "" Range("E12").Value = "" Range("F11").Value = "" Range("B21").Value = "" Range("B23").Value = "" Range("B25").Value = "" Range("B27").Value = "" Range("B29").Value = "" Range("P5:P9").Value = "" Range("Q5:Q9").Value = "" Range("P15:P19").Value = "" Range("Q15:Q19").Value = "" End Sub よろしくおねがいします。（_ _）

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する