Excel VBA実行時エラー1004の解決方法とは?

このQ&Aのポイント
  • Excel VBAを使用してファイルを開き、Rowsメソッドを実行する際に、実行時エラー1004が発生することがあります。
  • このエラーは、2回目の実行時にグローバルオブジェクトが解放されるために発生します。
  • 解決策としては、コードの最後で使用したオブジェクトを解放することなどがあります。
回答を見る
  • ベストアンサー

実行時エラー 1004 Rowsメソッドは失敗しま

アクセスからエクセルファイルを開いています。 Sub tset() Dim int行数 As Integer Dim xlApp As Object Dim xlWbk As Object Set xlApp = CreateObject("Excel.Application") xlApp.Visible = True Set xlWbk = xlApp.Workbooks.Open("C:\test.xlsx") xlApp.Sheets(1).Select int行数 = xlApp.Cells(Rows.Count, "A").End(xlUp).Row xlWbk.Close xlApp.Quit Set xlApp = Nothing End Sub このコードなのですが、1回目は普通にファイルが開いて閉じるのに 同じこのプロシージャーを2回連続で実行しようとすると 2回目は必ず int行数 = xlApp.Cells(Rows.Count, "A").End(xlUp).Row の部分で、 実行時エラー 1004 Rowsメソッドは失敗しました。 _Globalオブジェクト となります。 なぜ最初は問題なくコードが通るのに 2回目はダメなのでしょうか?

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

  • ベストアンサー
回答No.1

一回目が無事終了した後でタスクマネージャのプロセスタブで確認すると 無いはずのExcelプロセスがありませんか? http://hanatyan.sakura.ne.jp/vbhlp/ExcelErr.htm どこで発生しているのか突き止められませんでしたが下記では解消しました。 Sub tsetN1() Dim int行数 As Integer Dim xlApp As Object 'Excel.Application Dim xlWbk As Object 'excel.workbook Dim xlSht As Object 'excel.worksheet Set xlApp = CreateObject("Excel.Application") xlApp.Visible = True Set xlWbk = xlApp.Workbooks.Open("c:\tmp\test.xlsx") Set xlSht = xlWbk.Sheets(1) 'xlApp.Sheets(1).Select int行数 = xlSht.Cells(xlSht.Rows.Count, "A").End(xlUp).Row Set xlSht = Nothing xlWbk.Close: Set xlWbk = Nothing xlApp.Quit: Set xlApp = Nothing End Sub なお、せっかくExcelに参照設定をしているのでしょうから 変数の宣言はコメントの方に変えられた方が良いかな?と。 それとWindows Vista 以降はUAC?によってCドライブ直下は制約がありますので 避けた方が無難です。

gyueamqivqsvi
質問者

お礼

ご回答ありがとうございます。

関連するQ&A

  • 'Range'メソッドは失敗しました

    ExcelのVBAの質問になりますが、教えてください。 下記を動かすと最後の行で「'Range'メソッドは失敗しました: '_Worksheet' オブジェクト」と出ます どうしても最後の行をセレクトしたいのですが、どうしたらよいでしょうか。 Option Explicit Public WB1 As Workbook Public WB1SH1 As Worksheet Public CSVWB1 As Workbook Public CSVWB1SH1 As Worksheet Dim MaxRow As Integer Private Sub CommandButton1_Click() Set WB1 = ActiveWorkbook Set WB1SH1 = WB1.Worksheets(1) Dim a As String a = WB1SH1.Range("a1) Workbooks.Open "C:\Users\User\Desktop\" & a & ".CSV" Set CSVWB1 = ActiveWorkbook Set CSVWB1SH1 = CSVWB1.Worksheets(1) MaxRow = CSVWB1SH1.Cells(Rows.Count, 1).End(xlUp).Row WB1SH1.Activate WB1SH1.Range(Cells(1, 1), Cells(MaxRow, 3)).Select CSVWB1SH1.Activate CSVWB1SH1.Range(Cells(1, 1), Cells(MaxRow, 3)).Select  '←ここでエラーがでる End Sub

  • rangeメソッドは失敗しました

    またまたエラーが起きてしまいました、、 D列にある数値の平均値を出すマクロを組みたいのですが そのD列は今後増えていくので変数を使い指定したいのです Option Explicit Public Sub all() Const SH_NAME As String = "VBA" Dim i Dim endrow As Long Dim ws As Worksheet Dim Result As Integer Set ws = ThisWorkbook.Worksheets(SH_NAME) With ws endrow = .Cells(Rows.Count, 4).End(xlUp).Row For i = 2 To endrow Result = Application.WorksheetFunction.Average(.Range("D2:D&i")) .Range("F39").Value = Result .Range("F39").NumberFormatLocal = "0.00" Next i End With End Sub このコードだと Result = Application.WorksheetFunction.Average(.Range("D2:D&i")) のところでrangeメソッドは失敗しました と言われてしまいます どうかよろしくお願いします<m(__)m>

  • 複数行コピー、貼り付け実行時エラー1004

    ユーザー側が任意の場所を選択コピー し(2行毎) また 任意の位置に貼り付ける動作ですが 1回目のコピー、貼り付けは正常動作しますが 再度 コピー(任意の場所),貼り付け時に1004実行エラーが発生します。 下記はコードです。 どうかご教授お願いいたします。 Dim StartRow As Long, LastRow As Long, SRC As Long Sub コピー() If ActiveCell.Row < 76 Then Exit Sub StartRow = ActiveCell.Row: SRC = Selection.Rows.Count If (ActiveCell.Row Mod 2) = 0 Then StartRow = ActiveCell.Row If (Selection.Rows.Count Mod 2) = 0 Then LastRow = StartRow + Selection.Rows.Count - 1 Else LastRow = StartRow + Selection.Rows.Count End If Else StartRow = ActiveCell.Row - 1 If (Selection.Rows.Count Mod 2) = 0 Then LastRow = StartRow + Selection.Rows.Count + 1 Else LastRow = StartRow + Selection.Rows.Count End If End If ActiveSheet.Range(ActiveSheet.Cells(StartRow, 1), ActiveSheet.Cells(LastRow, 19)).Copy End Sub Sub 貼付け() If ActiveCell.Row >= 76 Or Application.ClipboardFormats(1) <> -1 Then ActiveSheet.Unprotect If (ActiveCell.Row Mod 2) = 0 Then StartRow = ActiveCell.Row Else StartRow = ActiveCell.Row - 1 End If ActiveSheet.Paste Destination:=Cells(StartRow, 1): Application.CutCopyMode = False ActiveSheet.Protect End If End Sub

  • range表記をcells表記にしたい

    B列の最終行までループさせたいのですが Sub Sample() Dim col As Long col = 2 For Each R In Range("B1:B" & Cells(Rows.count, "B").End(xlUp).Row) Next End Sub この状態から、Bを使わずに、 col = 2を使って、書き換えてもらっても良いですか? For Each R In Range(Cells(1, col), Cells((Rows.count, col)).End(xlUp).Row) これにするとエラーになります。

  • 配列 変数の宣言 VBA

    こんばんは。 Sub test() Dim myStr(200) As String For 行 = 0 To Cells(Rows.Count, 1).End(xlUp).Row myStr(行) = Cells(行 + 1, 1) Next MsgBox Join(myStr, "_") End Sub のようなコート゛を作成し、 アクティブシートのA列の最終行までを取得し、一つにまとめたいのですが 「Dim myStr(200) As String」の部分で 最終行を取得することは不可能でしょうか? 今回は200行なので大丈夫なのですが 場合によっては1行~65536行までさまざまです。 なので Dim myStr(Cells(Rows.Count, 1).End(xlUp).Row) As String としたらエラーになりました。 最初から Dim myStr(65536) As String とするべきでしょうか? しかしそうすると myStrの最後がずっと「________」となってしまいます。 どうするのが適切なのかわかりません。 ご教授よろしくお願いします。

  • エクセル 同じ内容行削除マクロ 2

    シート1、シート2(基準)のB列を比較して同じ内容行を削除したいのですが、「栃木県3」と「#栃木県3」を同じのもと考えて削除されてしまいます。 Sub 削除()   Dim wh1     As Worksheet   Dim wh2     As Worksheet   Dim f      As Range   Dim wR     As Integer   Dim mR     As Long   Dim wStr    As String   '   Set wh1 = Worksheets("Sheet1")   Set wh2 = Worksheets("Sheet2")   wR = 0   With wh1     mR = .Cells(Rows.Count, "A").End(xlUp).Row     For wR = mR To 1 Step -1       wStr = .Cells(wR, "B")       Set f = wh2.Range("B1:B" & wh2.Cells(Rows.Count, "B").End(xlUp).Row).Find(wStr)       If Not f Is Nothing Then         .Rows(wR).Delete       End If     Next   End With End Sub 解決策教えて下さい。

  • 『実行時エラー'1001': 'Range'メソッドは失敗しました:'

    『実行時エラー'1001': 'Range'メソッドは失敗しました:'_Worksheet'オブジェクト』 先週から仕事に必要なためVBAの勉強を始めましたが、別シートへコピーする際などに上記のエラーが発生してしまい原因が分からず困っています。どこが間違っているのでしょうか?? 処理はデータが書かれているシートから作業用のシートにセル範囲を指定してコピーする、というものです。 なお、マクロ自体は別にマクロ用ファイルを作成し、そこのシートモジュールへ記述しています。 よろしくお願いします。 Sub test() '--------- 対象ファイルの呼び出し Dim MAIN As Workbook Dim ws As Worksheet Dim sh As String 'ファイルを呼び出す Call GetMAINFile Set MAIN = ActiveWorkbook Set ws = MAIN.Worksheets(1) sh = ws.Name '--------- 一時作業用TEMPシートの作成 Dim TEMP As Worksheet Worksheets.Add(after:=ws).Name = "TEMP" Set TEMP = Worksheets("TEMP") '--------- 対象シートから一時作業用TEMPシートへデータのコピー Dim x1, x2, y1, y2 As Integer x1 = 5 x2 = 10 y1 = 1 y2 = 4 ws.Range(Cells(x1, y1), Cells(x2, y2)).Copy _ Destination:=TEMP.Range(Cells.SpecialCells(xlLastCell).Row, 1) End Sub '--------- ファイル名を指定ダイアログの表示 Sub GetMAINFile() Dim NewBook As Workbook Dim OpenFileName As String OpenFileName = Application.GetOpenFilename() If OpenFileName <> "False" Then Workbooks.Open OpenFileName Else Exit Sub End If End Sub

  • 実行時エラー1004発生する

    office2016 下記でsample1は実行されますが、条件の中身を変数にしたsample2は、実行時エラー1004になります。 Sub sample1() Dim BUSHO As String Sheets("Sheet2").Select BUSHO = Worksheets("MASTER").Range("AI2") '判定 Range("F1:F" & Range("B" & Rows.Count).End(xlUp).row).Value = "=IF(AND(RC[-2]<>""mecha"",RC[-1]<>""mecha""),""削除"","""")" End Sub sample1で動作するのを確認してsample2の変数版を作成しています。 なのでsample1ではBUSHO不使用です。 Sub sample2() Dim BUSHO As String Sheets("Sheet2").Select BUSHO = Worksheets("MASTER").Range("AI2") '判定 Range("F1:F" & Range("B" & Rows.Count).End(xlUp).row).Value = "=IF(AND(RC[-2]<>" & BUSHO & ",RC[-1]<>" & BUSHO & "),""削除"","""")" End Sub デバッグモードでBUSHOは”mecha"と表示されるのですが、何がおかしいのでしょう?

  • VBからExcelを操作

    VisualBasic6.0(初心者) VBを始めたばかりで、Excelの入力文字をVBで変換しようと考えています。 様々な保管場所にあるExcelを開いて選択セルの文字をコマンドボタンで変換しようと下記コードを考えました。(一部) 問題は、Load時にすでに開いているExcelを閉じてまいます。 何か良い方法は無いでしょうか?(アクティブなExcelを操作したい) また、下記コードで不適切なところがありましたら御教授願います。 Private Sub Form_Load() Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Add Set xlSheet = xlBook.Worksheets(1) Set xlApp = GetObject(, "Excel.Application") With xlApp.Selection Cells(1, 1).Value = "" End With xlApp.DisplayAlerts = False xlApp.Quit Set xlSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing End Sub '----------------------(大文字変換) Private Sub CB2_Click() On Error Resume Next If ActiveCell.Row = Null Then MsgBox "Excel が見つかりません" Else Dim xlApp As Excel.Application Set xlApp = GetObject(, "Excel.Application") If Err.Number Then MsgBox "Excel が起動されていません" Else Dim X As Long Dim Y As Long Dim Hmae As String Dim Hgo As String X = 0 Y = 0 With xlApp.Selection Do Do Hmae = Cells(ActiveCell.Row + X, ActiveCell.Column + Y).Value Hgo = StrConv(Hmae, 1) Cells(ActiveCell.Row + X, ActiveCell.Column + Y).Value = Hgo X = X + 1 Loop Until X >= .Rows(.Rows.Count).Row - .Row + 1 X = 0 Y = Y + 1 Loop Until Y >= .Columns(.Columns.Count).Column - .Columns(1).Column + 1 End With End If xlApp.DisplayAlerts = False Set xlApp = Nothing End If End Sub

  • PasteSpecialメソッドの失敗

    会社でVBAの勉強をしているのですが、 自分でコードを書いてみたところエラーが出て困っております 初心者なのでエラーの意味もわからずここにきました みなさまよろしくお願いします(・・;) Sub nigate() Const SH_NAME As String = "おはようございます" Dim i Dim ws As Worksheet Dim writerow As Integer Dim endrow As Long Set ws = ThisWorkbook.Worksheets(SH_NAME) writerow = 2 With ws endrow = .Cells(Rows.Count, 2).End(xlUp).Row .Columns("M:N").Clear For i = 2 To endrow If Range("D" & i).Font.ColorIndex = 3 Then Range("C" & i).Copy Range("L" & writerow) .PasteSpecial xlPasteAllExceptBorders writerow = writerow + 1 Application.CutCopyMode = False ElseIf Range("D" & i).Interior.ColorIndex = 36 Then Range("C" & i).Copy Range("K" & writerow) .PasteSpecial xlPasteAllExceptBorders writerow = writerow + 1 Application.CutCopyMode = False End If Next i End With End Sub これを実行すると、 PasteSpecialメソッドは失敗しました`Worksheet`オブジェクト と表示され止まってしまいます コードで言うと .PasteSpecial xlPasteAllExceptBorders のところが黄色くなります よろしくお願いしますm(__)m

専門家に質問してみよう