• 締切済み

マクロ実行中エラーが発生する

いつも回答して頂きありがとうございます。 ws.Cells(7, c).ClearContentsの箇所で『excel2010』ではエラーが発生しませんでしたが、『excel2003』ではエラーが発生しました。(オブジェクトが・・・・みたいなコメント有。)原因は何でしょうか?御指導の程宜しくお願い致します。 Sub 特定のシート以外の最終履歴と次回予定日を算出する() Dim ws As Worksheet For Each ws In Worksheets If ws.Name <> "一覧" Then If ws.Name <> "メニュー" Then Dim c As Integer c = 3 Do While ws.Cells(2, c).Value <> "" With ws.Cells(6, c) .FormulaR1C1 = "=MAX(R8C:R10000C)" If .Value = 0 Then .Value = "履歴無し" ws.Cells(7, c).ClearContents'ここでエラーが発生 Else .Value = .Value ws.Cells(7, c) = DateAdd("d", ws.Cells(5, c), DateAdd("m", ws.Cells(4, c), DateAdd("yyyy", ws.Cells(3, c), ws.Cells(6, c)))) End If End With c = c + 1 Loop End If End If Next End Sub

みんなの回答

回答No.2

こんにちは。 一般的に、VBAは、上位互換はあっても、下位互換はないと思ったほうがよいです。 だから、不具合があった場合は、そのままブックを持ってくるのではなくて、一旦、コードをエクスポートするなりして、テキスト化させるなりして、新しいブックで作りなおすとかしたほうがよいですね。それから、一旦、実行する前に、このレベルなら、ステップマクロで、確認したほうがよいかもしれません。 #1さんのおっしゃる現象は確かにあるのですが、Excelの場合は、ちょっと事情が違うこともあるようです。 なお、下位バージョンから上へは、記録マクロ以外なら、だいたい動きます。 ただ、それ以上、そのコードでは、何も言えません。本当は、コード全体をを直したほうがよいと思いますが、それ自体は、私が、あれが悪いこれが悪いと言ったところで、いろんな人の書き方が混じり合っているし、それで混乱させても、解決からは遠くなりそうな気がします。もともと、全体的な位置関係や処理は、最初の時から私は把握できていませんし、その処理自体が有効かそうでないかさえ、はっきり言えませんでした。 VBAの書き方から教えてくれる人は、めったにいませんし、掲示板の趣旨が違いますね。 前回(7790178)の >ファイルオープン時にApplication.Runで3つのマクロを実行させているのですが のほうは、締まりましたが、それで、それ自体は解決したのでしょうか? なぜ、Application.Run なのか、コードを見る限りでは、理由が分かりませんでした。他のブックからの制御ということになるのだとは思いますが、そういうコードの場合は、少し書き方が違ってくることが多いのです。

kero1192kero
質問者

お礼

返事が遅くなってすみません。たぶん、エクセル2003ではデータがないセルにClearContentsは使えないって事なんだと思いました。ですので、一旦何らかのデータを入れた後にClearContentsを実行するようにして問題が解決しました。 あと、前回の質問での「Application.Runを3つ連続して実行する」かですが、ただ単に、全てのマクロを1つの記述で書ききることが、自分には難しいからです。前回の質問まで心配して頂きありがとうございました。

  • bon459
  • ベストアンサー率36% (4/11)
回答No.1

以前、エラーになると思えない箇所でエラーになったときの経験からです。 一度確認して見てください。 2003側のVisualBasicエディタでツール→参照設定を選択します。 ここに参照不可と表示されているライブラリが無いでしょうか? そうであれば、参照不可となっているライブラリのチェックを外し、 同じ名称のバージョン違いのライブラリにチェックを付け直すことで 動いたことがあります。

kero1192kero
質問者

お礼

回答ありがとうございました。 長い間、返事もせずすみません。たぶん、何もデータがないセルをエクセル2003ではClearContents出来ないからだと思います。ですので、一旦、何らかのデータを入れてやることにしました。処理手順が一つ増えるのであれなんですが、一応解決しました。

関連するQ&A

  • ファイルオープン時のマクロが一部実行されない

    いつも回答して頂き、ありがとうございます。感謝感謝です。 ファイルオープン時にApplication.Runで3つのマクロを実行させているのですが、最後のマクロだけ実行されません。どうしてでしょうか?もしかして、前の2つで『一覧シート』を除外するマクロを実行しているからでしょうか?御指導の程宜しくお願いいたします。 1番目に実行するマクロ Sub 特定のシート以外の最終履歴と次回予定日を算出する() Dim ws As Worksheet For Each ws In Worksheets If ws.Name <> "一覧" Then If ws.Name <> "メニュー" Then Dim c As Integer c = 3 Do While ws.Cells(2, c).Value <> "" With ws.Cells(6, c) .FormulaR1C1 = "=MAX(R8C:R10000C)" If .Value = 0 Then .Value = "履歴無し" ws.Cells(7, c).ClearContents Else .Value = .Value ws.Cells(7, c) = DateAdd("d", ws.Cells(5, c), DateAdd("m", ws.Cells(4, c), DateAdd("yyyy", ws.Cells(3, c), ws.Cells(6, c)))) End If End With c = c + 1 Loop End If End If Next End Sub 2番目に実行するマクロ Sub 期限の未達と到達を色で分ける() Dim ws As Worksheet For Each ws In Worksheets If ws.Name <> "一覧" Then If ws.Name <> "メニュー" Then Dim c As Long Dim res As Variant For c = 3 To ws.Cells(7, Columns.Count).End(xlToLeft).Column If IsDate(ws.Cells(7, c)) Then If ws.Cells(7, c) > Date Then res = 8 Else res = 3 End If Else res = xlNone End If ws.Cells(7, c).Interior.ColorIndex = res Next c End If End If Next End Sub 3番目に実行するマクロ Sub 各シートの情報を一覧へ転記する() Dim d As Integer Dim retu As Integer d = 3 Do While Cells(d, 2).Value <> "" With Worksheets(Worksheets("一覧").Cells(d, 2).Value) .Activate retu = .Range("IV7").End(xlToLeft).Column .Range(Cells(7, 3), Cells(7, retu)).Copy End With With Worksheets("一覧") .Activate Cells(d, 3).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False End With d = d + 1 Loop End Sub

  • マクロ 結合セルに対しての処理方法

    いつも回答ありがとうございます。 例えば、7行目から10000行目まで、(D:E)を結合したセルに日付[yyyy/m/d]が入力されています。その入力した最終の日付を(C5:E5)の結合されたセルに表示させるようにしたいのですが、下記の記述では範囲の選択が上手くいかず、最終日が表示されませんでした。結合されたセルに対しての記述はどのようにしたら良いのでしょうか?御指導の程宜しくお願い致します。 Sub 特定のシート以外の最終履歴と次回予定日を算出する() Dim ws As Worksheet For Each ws In Worksheets If ws.Name <> "一覧" Then If ws.Name <> "メニュー" Then Dim c As Integer c = 3 Do While ws.Cells(2, c).Value <> "" With ws.Cells(5, c) .FormulaR1C1 = "=MAX(R7C1:R10000C1)" If .Value = 0 Then .Value = "履歴無し" Else .Value = .Value ws.Cells(6, c) = DateAdd("d", ws.Cells(4, c + 2), DateAdd("m", ws.Cells(4, c + 1), DateAdd("yyyy", ws.Cells(4, c), ws.Cells(5, c)))) End If End With c = c + 3 Loop End If End If Next End Sub

  • マクロ Date関数の使用中に・・・・

    未来の日付を算出するなかで、起算日(C6セル)にyyyy/m/d以外の情報が入っている場合エラーがかかってしまいます。何故、yyyy/m/d以外の情報が入るかと申しますと、前段階のマクロ処理の中で選択範囲の中に『0 ゼロ』が含まれている場合、履歴無しと入力されてしまうからです。 この場合、前段階のマクロを修正した方が良いのでしょうか?それとも以下のマクロを修正するだけでOKなのでしょうか?御指導お願いします。 Sub シート単位で周期到達日を繰り返し算出する() Dim c As Integer c = 3 Do While Cells(2, c).Value <> "" Cells(7, c) = DateAdd("yyyy", Cells(3, c), Cells(6, c)) Cells(7, c) = DateAdd("m", Cells(4, c), Cells(7, c)) Cells(7, c) = DateAdd("d", Cells(5, c), Cells(7, c)) c = c + 1 Loop End Sub 一応、前段階のマクロ処理を記載しときます。 Sub 一覧以外の全シートの最終履歴を表示する() Dim ws As Worksheet For Each ws In Worksheets If ws.Name <> "一覧" Then Dim c As Integer c = 3 Do While ws.Cells(2, c).Value <> "" With ws.Cells(6, c) .NumberFormatLocal = "G/標準" .Value = Application.WorksheetFunction.Max(ws.Range(ws.Cells(8, c), ws.Cells(10000, c))) .Replace What:="0", Replacement:="履歴無し", LookAt:=xlWhole .NumberFormatLocal = "yyyy/m/d;@" End With c = c + 1 Loop End If Next End Sub

  • 検索マクロ

    下記のマクロは、検索文字でシートを検索し、そのセルアドレス情報を シートを追加して表示する機能ですが、BOOK全体に検索し、シート名を含めて表示するには、xxxxのところをどのように変更すればいいか。よろしくお願いします。 Sub kennsaku_Macro1() Dim ret Dim r As Range Dim adr As String Dim cnt As Long Dim psw As Boolean Dim mySht, adSht, ws As Worksheet Set mySht = ActiveSheet ret = Application.InputBox("検索文字列を入力してください") If TypeName(ret) <> "Boolean" Then With mySht.Cells Set r = .Find(ret, LookIn:=xlValues, lookat:=xlPart) If Not r Is Nothing Then adr = r.Address cnt = 2 '2行目から表示 xxxxxxxxxxxxx For Each ws In Worksheets If ws.Name = "検索結果" & ret Then psw = True Exit For End If Next ws If psw Then Set adSht = ws adSht.Cells.ClearContents Else Set adSht = Worksheets.Add adSht.Name = "検索結果" & ret End If adSht.Cells(cnt, 1).Value = r.Value adSht.Cells(cnt, 2).Value = xxxx 'シート名 adSht.Cells(cnt, 3).Value = adr Do Set r = .FindNext(r) If r.Address = adr Then Exit Do Else cnt = cnt + 1 adSht.Cells(cnt, 1).Value = r.Value adSht.Cells(cnt, 2).Value = xxxx 'シート名 adSht.Cells(cnt, 3).Value = r.Address End If Loop End If End With End If adSht.Cells(1, 1).Value = "項目" adSht.Cells(1, 2).Value = "シート名" adSht.Cells(1, 3).Value = "セルアドレス" mySht.Activate End Sub

  • エクセル マクロ修正

    シート1~5まであります。別に情報シートを作成しています それぞれ同じ原本から作成しています 全部のシートにA1~A10のセルに日付、B1~B10のセルに文字など入力がするところがあります 入力はA1から順番に入れていきます 例えば 保存ボタンを作成しておく シート1のA1に日付、B1に”文字”を入力し、保存ボタンをおす 情報シートに日付と内容が一致する情報がなければ、 情報シートのA列にシート名、B列に日付、C列に入力した内容が 空白のところに出力される ボタンのマクロがCommandButton1_Clickとしたら Private Sub CommandButton1_Click() 検索 End Sub 標準モジュールに Sub 検索() Dim c As Range Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws1LastRow As Long Dim ws2LastRow As Long Set ws1 = Sheets("情報シート") Set ws2 = ActiveSheet If ws2.Range("A1").Value = "" Or ws2.Range("B1").Value = "" Then MsgBox "検索する日付もしくは語句が入力されていません。", vbCritical Exit Sub End If If ws1.Range("A1").Value = "" Then ws1LastRow = 0 Else ws1LastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row End If ws2LastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row For Each c In ws1.Range(ws1.Cells(1, "B"), ws1.Cells(Rows.Count, "B").End(xlUp)) If c.Value2 = ws2.Cells(ws2LastRow, "A").Value2 Then If c.Offset(0, 1).Value = ws2.Cells(ws2LastRow, "B").Value Then MsgBox "既にデータが存在します", vbInformation Exit Sub End If End If Next ws1.Cells(ws1LastRow + 1, "A").Value = ws2.Name ws1.Cells(ws1LastRow + 1, "B").Resize(1, 2).Value = ws2.Cells(ws2LastRow, "A").Resize(1, 2).Value MsgBox "データを追加しました", vbInformation Set ws1 = Nothing Set ws2 = Nothing End Sub これを教えて頂き作っていたのですが 別のシートを作成しこのプログラムを応用していたのですが うまく起動しないため再度投稿しました 今度のやつは固定でやろうと思っていていじったのですが 別の欄の文字が表示してしまった 結合セルB2:C4に日付を入れる 結合セルL2:L30に内容を入れるようにしたいのですが ここだけのセルを参照するようにしたいのです。 どうすればいいでしょうか? 試したことAをB2にかえ、BをL2にしたら変なことになりました・・・

  • 実行時エラー

    先日はご回答いただきありがとうございました。 ご回答いただいた構文を採用してテストしてみましたところ、特定の操作時にエラーが発生してしまいました。 発生条件:「管理」部署のユーザー・シート3人と「総務」部署のユーザー・シート2人を用意      「管理」の管理職でログインしたあと、「総務」の管理職でログインを試みるとエラーが発生 発生エラー:実行時エラー'1004' 'Visible' メソッドは失敗しました: '_Worksheet' オブジェクト エラー発生箇所:ws.Visible = False(下から4行目) お手すきの時で構いませんので、宜しければご回答お願いいたします。 ElseIf isManage Then '管理職なら Dim i As Integer For i = 1 To login.Cells(Rows.Count, eColIndex.depcode).End(xlUp).Row On Error Resume Next 'エラートラップ開始 Set ws = Sheets(login.Cells(i, eColIndex.name).Value) 'Sheets("氏名") On Error GoTo 0 'エラートラップ終了 If login.Cells(i, eColIndex.depcode).Value = depcode Then If ws Is Nothing Then 'シートが無いなら MsgBox "ユーザーシートがありません", vbExclamation, "警告" Application.Visible = True 'ブックを表示 End End If ws.Visible = True 'ユーザーのシート表示 Set ws = Nothing ElseIf Not ws Is Nothing Then ws.Visible = False Set ws = Nothing End If Next

  • 実行時エラー13 型が一致しません。エラー2029

    エクセルです。 A1に「=a」と文字が入っていて、 #NAME? となります。 その状態でvbaで セルA1に「=a」が入っているのなら としたい為、 Sub test() If Cells(1, 1) = "=a" Then End If End Sub こうしたのですが、 実行時エラー13 型が一致しません。 になります。 vba中断中に、Cells(1, 1)の部分にマウスカーソルを当ててみると エラー 2029 となっています。 If Cells(1, 1) = "=a" Then が無理なら、 If Cells(1, 1) = "#NAME?" Then なら行けるかな?と思いましたが、 全く同じエラーになります。 最終的に何がやりたいかと言うと、 Sub test() If Cells(1, 1) = "=a" Then Rows(1).delele End If End Sub のように、#NAME?の場合は、その行を削除したいです。

  • セルの値が0はクリアするマクロ

    エクセル2003です。 ある集計表において 4行目のH列からAM列まで 数値データがあります。 最終行は常に変化します この表内にてセルの値が0のセルは セル内を空白にしたいです。 以下のマクロを作成しましたが If Cells(処理行, 8).Value = 0 Then Cells(処理行, 8).ClearContents をあと(処理行, 13)から(処理行,31) まで記述しなければなりません。 構文的にも処理的にも不利? と思うので、なにかいい方法を教えてください。 Sub 数字0クリア() '2012年2月3日節分 Dim 最終行 '最終列をG列で求めます 最終行 = Cells(Rows.Count, 7).End(xlUp).Row Application.ScreenUpdating = False For 処理行 = 4 To 最終行 If Cells(処理行, 8).Value = 0 Then Cells(処理行, 8).ClearContents End If If Cells(処理行, 9).Value = 0 Then Cells(処理行, 9).ClearContents End If If Cells(処理行, 10).Value = 0 Then Cells(処理行, 10).ClearContents End If If Cells(処理行, 11).Value = 0 Then Cells(処理行, 11).ClearContents End If If Cells(処理行, 12).Value = 0 Then Cells(処理行, 12).ClearContents End If If Cells(処理行, 13).Value = 0 Then Cells(処理行, 13).ClearContents End If Next 処理行 Application.ScreenUpdating = True MsgBox "終了しました" End Sub

  • 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

  • マクロ エクセル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

専門家に質問してみよう