Do While中のVBAアプリケーション定義エラー

このQ&Aのポイント
  • Win2000、Excel2000で作業をしています。無限ループで、Sheet1を監視し、特定のセルに「1」が入ったら別のセルの内容を変更すると言うものです。
  • 何度目かに「1004)アプリケーション定義またはオブジェクト定義のエラーです」とでます。
  • ハイライトもしなくて、どこで落ちているのかわからず困っています。ちなみに、1をvalで見ても同じで、1秒ごとに見ても同じでした。
回答を見る
  • ベストアンサー

Do While中のVBAアプリケーション定義エラー

Win2000、Excel2000で作業をしています。 無限ループで、Sheet1を監視し、特定のセルに「1」が入ったら別のセルの内容を変更すると言うものです。 ここで、何度目かに「1004)アプリケーション定義またはオブジェクト定義のエラーです」とでます。 (テストのため、(1,5)のセルに何か書き込み、(1,3)に1を入れるというのを繰り返していると、(1,5)に書き込んだ時に出る。) Do While True If Sheet1.Cells(1, 3) = "1" Then Sheet1.Cells(1, 5) = "" Sheet1.Cells(1, 6) = "0" End If DoEvents Loop ハイライトもしなくて、どこで落ちているのかわからず困っています。 ちなみに、1をvalで見ても同じで、1秒ごとに見ても同じでした。 どなたか原因の心当たりのあるから、ご助力お願いいたします。

  • skink
  • お礼率66% (2/3)

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

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.3

こんにちは。Wendy02です。 >エラーの原因ってのは結局どこなのか・・・。 失礼かもしれませんが、基本的なコードの部分で疑問の付くところが多いのです。その段階で、エラーの原因をお知りになっても、あまり役に立たないように思います。 >「1004)アプリケーション定義またはオブジェクト定義のエラーです」 今回は、ワークシートのオブジェクトとCellsの不整合のエラーだと思います。直接の原因は、Sheet1 とされたことが原因で、現在使用中のオブジェクトが、Sheet1 とは限りませんので、定義エラーを起こしています。結果的にはモジュール違いのことが多いです。こういう場合、標準モジュールを使って、シートを指定しないでください。 次に、リテラルで、"1"と文字列を使っていますが、あまり、文字列で指定する方法はしません。VB/VBAは、こういうところが、曖昧なのですが、曖昧な部分に甘えていると失敗することがあります。 数字が文字列であるという確証がない場合は、数値にして比較するのが標準的です。 そして、また、Sheet1.Cells(1, 5) と、プロパティを指定していません。 Cells(1,5).Value か、Cells(1,5).Text [←あまり使いません]を使うかして、それを比較してください。 If Cells(1, 3).Value = 1 Then 最初は、標準的な文法に従って、マクロを作ってください。 Do While True また、これでは、条件が成り立ちません。ですから、基本的にありえません。 エラーの原因を知りたいという気持ちは分らないわけではありませんが、1つずつ言及して直していったら、とても使える段階には至らないと思います。 基本的な構文や文法を覚えてから、エラーの原因を把握するようにしたほうが良いと思います。自己流や掲示板をみて、自分で加工している状態では、うまくなりません。特に、掲示板では、玉石混交で、ひどい内容の解答もあります。動けば文句ないだろう、と開き直られてしまいますので、どうしようもない方もいます。 エラーを把握するのは、それぞれのオブジェクトとプロパティを良く理解して、かなり高度な知識が必要になることが多いです。Visual Basic 側を使うようになってからでも遅くはありません。 九天社という出版社から、『Excel VBA 実践のツボ デバッグ編』という本があります。エラーについて書かれていますが、これらに出てくる内容は、あきらかに上級の内容です。この著者は、たぶん、コードの書き方からすると、VBAの専門ではないようですが、なかなか、VBAだけ勉強していっても届かないレベルの内容なのです。 あまり、入門レベルでは、考え込まないほうがよいと思います。

skink
質問者

お礼

Wendy02さん、詳しくどうもありがとうございます。 実は・・・VBは触ってるんですが、VBAが初めてでして。 Excel特有のものや、VBでできてVBAではできないものなどまだ理解がぜんぜん足りないようです。 オブジェクトとプロパティですね。 使い方しっかり覚えていきたいと思います。

その他の回答 (2)

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

こんばんは。 もし、ループする場合は、API SleepやTimer()関数などで、Applicationを保護したほうがよいですね。おっしゃるように、1秒ぐらいで十分だと思います。これは、旧式のイベントです。Timer関数は、止めるほうのプロシージャーが必要です。 × Do While True 何が、True なのか分りません。 例えば、 Private Declare Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long) Sub TestLoop() Do  Sleep 1000 If Sheet1.Cells(1, 3).Value = 1 Then   Exit Do End If   DoEvents Loop   Sheet1.Cells(1, 5).Value = ""   Sheet1.Cells(1, 6).Value = 0 End Sub

skink
質問者

お礼

ありがとうございます。遅くなりましてすみません。 試してみます。 んー。しかし、エラーの原因ってのは結局どこなのか・・・。

  • masa_019
  • ベストアンサー率61% (121/197)
回答No.1

申し訳ありませんが、質問に対する直接の回答ではないです。 >Sheet1を監視し、特定のセルに「1」が入ったら別のセルの内容を変更する このような場合、Worksheet_Changeを使ったほうが、 良いのではと思いますが・・・。 Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Cells(1, 3)) Is Nothing Then Exit Sub Application.EnableEvents = False If Target.Value = "1" Then Cells(1, 5) = "" Cells(1, 6) = "0" End If Application.EnableEvents = True End Sub

skink
質問者

補足

ありがとうございます。 Worksheet_Changeを使ったつもりで、Worksheet_SelectionChangeを試していたかもしれません。 値は通信ではいってくるのですが、認識されるのでしょうか? とりあえず、通信のテスト環境がないので、ずっと監視していれば間違いないかと思い、上記の策をとりました。 結果として、Worksheet_ChangeでOKだとしても、なにが原因のエラーなのかを知りたいので、引き続き回答を募集させていただきます。

関連するQ&A

  • VBA マクロ エラー1004 アプリケーション定義またはオブジェクト定義のエラー

    VBAで正当表と入力表の正誤判定を一気に行いたいのですが If Cells(a, b).Value = Cells(c, d).Value Thenの部分で エラー1004、アプリケーション定義またはオブジェクト定義のエラーと出てしまいます。 エラーの対処の仕方を調べたのですがわかりませんでした。 教えていただけるとありがたいです。 以下作ったプログラムです。 Sub 正誤判定() Dim a Dim b Dim c Dim d Dim e Dim i Dim j Dim x Dim y Dim hokan Dim ytate Dim xyoko a = 3 b = 21 c = 3 d = 43 e = 2 i = 1 j = 1 Do While j < 261 Do While i < 11 If Cells(a, b).Value = Cells(c, d).Value Then a = a + 1 c = c + 1 If Cells(a, b) = Cells(c, d) Then hokan = Cells(e, b).Value ytate = Range("B2:S15").Find(hokan, lookat:=xwhole).Row + 15 xyoko = Range("B2:S15").Find(hokan, lookat:=xwhole).Column Cells(ytate, xyoko).Value = Cells(ytate, xyoko).Value + 1 Else End If Else End If a = a - 1 c = c - 1 b = b + 1 d = d + 2 i = i + 1 Loop a = a + 3 c = c + 3 e = e + 3 j = j + 1 Loop End Sub

  • VBA アプリケーション定義またはオブジェクト定義エラーについて

    doc_wbkというブックのSheets(2)の内容をdoc_wbk2のActiveSheetにコピーしようとしています。 以下のコードの5行目で「アプリケーション定義またはオブジェクト定義エラー」が出てしまいます。ブックやシートまで指定しないといけないのかと思い doc_wbk.Sheets(2) を5行目行頭に追加しましたが変わりません。逆に5行目行頭の . を外してやるとアクティブシートの内容をコピーしてしまいます。Sheets(2)の内容をコピーしてやるにはどうしたらよいでしょうか?よろしくお願いします。 Set doc_wbk = Workbooks.Open(doc_dir + doc_file, 0) With Sheets(2) If .Range("A4").Value <> "" Then row_num = .Range("a65536").End(xlUp).Row .Range(Cells(4, 1), Cells(row_num, 11)).Copy doc_wbk2.ActiveSheet.Cells(row_num2 + 1, 1) End If End With

  • 「アプリケーション定義またはオブジェクト定義のエラー」の解決

    sheet1からsheet2に転記するにあたっての質問です。 sheet1の数値を使ってuとzを計算し、それをsheet2に出力したいのですが 「アプリケーション定義またはオブジェクト定義のエラーです」 というエラーが出てしまいます。現在のコードは以下になります。 どのように直せば良いのか教えて下さい。 Worksheets("Sheet2").Cells(n, j + 1).Value = u Worksheets("Sheet2").Cells(n + 1, j + 1).Value = z

  • VBA アプリケーション定義エラー・・・について

     エクセルで表現すれば、=IF(OR($G11="",COUNTIF(H11:BN11,"k")>0),"",INT(AVERAGE(H11:BN11)*10+0.5)/10))という式をVBAで以下のように記述したところ、アプリケーション定義エラーまたはオブジェクト定義エラーが出ました。 For i = 1 to 410 Sheets("評定").Cells(i + 10, 79).Formula = "=IF(OR($G" & i + 10 & "=" & Chr(34) & "" & Chr(34) & ",COUNTIF("H11:BH11," & Chr(34) & "k" & Chr(34) & ">0)," & Chr(34) & "" & Chr(34) & ",INT(AVERAGE("H11:BN11")*10+0.5)/10))" next i  どのように書き換えればよいのでしょうか。お教え下さい。

  • VBA アプリケーション定義またはオブジェクト定義のエラーです

    VBA初心者です。 仕事中、暇な時にVBAの勉強をしています。 あるファイルのフォーマットを指定されたフォーマットに変換するプログラムを作成しています。 実行後、「アプリケーション定義またはオブジェクト定義のエラーです」と出て、先に進めません。 どなたが分かる方、ご教授お願い致します。 以下ソース Private Sub CommandButton1_Click() ' 変数定義 Dim openFileName As String Dim priorYearBudget As String, thisYearBudget As String, increaseAnddecrease As String Dim bigSection As String, mediumSection As String, smallSection As String Dim fileLastRow As Long, buf As Long, index As Long Dim head As String ' 初期化 index = 2 ' ファイル名取得 openFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls") If openFileName <> "False" Then ' ファイルが存在したらファイルを開く Workbooks.Open openFileName ' 項目を変数に格納 ' bigSection = Sheets(1).Cells(1, 3) ' mediumSection = Sheets(1).Cells(1, 4) ' smallSection = Sheets(1).Cells(1, 5) priorYearBudget = Sheets(1).Cells(1, 6) thisYearBudget = Sheets(1).Cells(1, 7) increaseAnddecrease = Sheets(1).Cells(1, 8) ' ファイルの最終行を取得(データが格納されている行) fileLastRow = ActiveSheet.Cells.SpecialCells(xlLastCell).Row ' ワークシートの追加 Worksheets.Add after:=Worksheets("Sheet1") ' セルの幅指定 Columns("A").Select Selection.ColumnWidth = 70 Columns("B:D").Select Selection.ColumnWidth = 13 Columns("A").Select ' 幅設定で選択されたセルを解除 range("A1").Select ' 新規に追加されたワークシートに項目を設定 Sheets(2).Cells(1, 1).Value = "勘定科目" Sheets(2).Cells(1, 2).Value = priorYearBudget Sheets(2).Cells(1, 3).Value = thisYearBudget Sheets(2).Cells(1, 4).Value = increaseAnddecrease ' 元ファイルの見出しの形式を変更 For headCnt = 1 To fileLastRow head = Sheets(1).Cells(headCnt, 1) bigSection = Sheets(1).Cells(index, 3) midiumSection = Sheets(1).Cells(index, 4) smallSection = Sheets(1).Cells(index, 5) If head <> "" Then ' 項目設定 Sheets(2).Cells(headCnt, 1).Value = "【" & head & "】" End If If bigSection <> "" Then ' 大区分設定 Sheets(2).Cells(buf, 1).Value = bigSection←ここでエラー発生 ElseIf midiumSection <> "" Then ' 中区分設定 Sheets(2).Cells(buf, 1).Value = midiumSection ElseIf smallSection <> "" Then ' 小区分設定 Sheets(2).Cells(buf, 1).Value = smaillsection End If ' Sheets(2).Cells(cnt, 1).Value = head ' head = Sheets(1).Cells(cnt, 1) index = index + 1 buf = buf + 1 Next headCnt ' 元ファイルの金額をそのままコピー For budgetCnt = 2 To fileLastRow Sheets(2).Cells(budgetCnt, 2).Value = Sheets(1).Cells(budgetCnt, 6) Sheets(2).Cells(budgetCnt, 3).Value = Sheets(1).Cells(budgetCnt, 7) Sheets(2).Cells(budgetCnt, 4).Value = Sheets(1).Cells(budgetCnt, 8) Next budgetCnt Else MsgBox "キャンセルされました" Exit Sub End If End Sub 補足 エラーが発生する箇所をコメントアウトすると、正常に動作します。 よろしくお願い致します。

  • エクセルVBAでセルのクリックイベントについて

    エクセルのVBAでDo Whileループの中で,いずれかのセルがクリック され(アクティブ)になったことを知る方法が分かりません。 調べたいセルの個数は数十個で,セルのクリックを連続的に行い, その度に,ある操作を行いたいのです。 Do while flag=true   if ActiveCell.Address="A1" then ****   if ActiveCell.Address="A2" then ****   if ActiveCell.Address="A3" then ****   (これをいくつか記述)   (ループから抜け出る記述) loop これだと,無限ループに陥ってしまいます。 どなたか,お知恵をお貸しください。

  • VBA Do~Loopについて

    VBA勉強中です。 マクロの作成は完了しているのですが、処理効率について指摘を受け、 その際に助言もいただいたのですが、自身の勉強不足、理解不足で どのように変更すれば良いのか分からず、教えていただきたいです。 Do While Ax2 <= 30 で30回繰り返すのではなく (Cells(Ax2,"B").Value <> "" ) の間繰り返すように変更したいです。 ---------------- Sub test()  Dim File1(30) As string  Dim Sheet1(30) As string  Dim Sheet2(30) As string  Dim Cnt As Integer  Ax1=1  Ax2=7  Do While Ax2 <= 30    If Cells(Ax2, "B").Value <> "" Then     File1(Ax1) = Cells(Ax2, "B").Value     Sheet1(Ax1) = Cells(Ax2, "C").Value     Sheet2(Ax1) = Cells(Ax2, "D").Value     Cnt =Ax1    End If    Ax1 = Ax1 + 1    Ax2 = Ax2 + 1  Loop End Sub ---------------- お手数ですが、よろしくお願いいたします。

  • Do whileでExitせず、ループの最初に戻る方法

    よろしくお願いします。 環境 Excel 2003 Do whileのループ内で、Exitのような記述方法で、ループの最初に戻る方法はありますでしょうか? イメージは以下のような形です。 Sub hoge() r = 0 rr = 5 Do While r < 6 'ここに戻る If r = 3 Then 'ここでDo while の最初に戻る End If Loop End Sub よろしくお願いいたします。

  • VBAの定義と印刷について

    VBAで下記の様に定義をして印刷していますが、sheet"AAA","BBB"と同じく 新しいsheet"DDD"もの一緒に印刷したい場合の定義はどうなるのでしょう!教えて頂けますでしょうか。 よろしくお願いします。 別sheetの"sheet1"A列 AAA,BBB,CCC          B列 1,2,3  として印刷フラッグがある。 VBAでは Sub sheet1印刷() CNT = 4 CNT1 = 1 CNT2 = 1 TAKE = 0 CK = 30 Do Until CNT2 = CNT Do Until CNT1 = 4 If Sheets("sheet1").Cells(CNT1, 1) = Sheets("sheet1").Cells(CNT2, 3) Then TAKE = Sheets("sheet1").Cells(CNT1, 2) Select Case TAKE Case 1: Sheets("AAA").PrintOut Copies:=1 Case 2: Sheets("BBB").PrintOut Copies:=1 Case 3: Sheets("CCC").PrintOut Copies:=1 End Select CNT1 = 1 Exit Do Else: CNT1 = CNT1 + 1 End If Loop CNT2 = CNT2 + 1 Loop End Sub

  • VBA アプリケーション・オブジェクト定義のエラー

    ある行と別の行と同じ内容の文章が入っている場合、それを削除するマクロをくんでいますが、 アプリケーション・オブジェクト定義のエラーとのことで作動してくれません。。。 以下のような記述なのですが、アドバイスをいただけたら幸いです。 よろしくお願いいたします。 Sub 重複削除() Dim dataend Cells(Rows.Count, 5).End(xlUp).Select dataend = ActiveCell.Row For i = 2 To dataend - 1 For k = 1 To dataend - i If Cells(2, i).Value = Cells(2, i + k).Value Then '''''''''''''''''''''ここでひっかかる Rows(i + 1).Select Selection.Delete End If Next Next End Sub

専門家に質問してみよう