VBAエラー

前へ 次へ
このQ&Aのポイント
  • VBAエラーが発生し、rangeクラスのselectメソッドが失敗しています。特にオートフィルタの部分で止まってしまいます。
  • エクセルファイルを開き、指定したシートでオートフィルタを行うVBAマクロです。
  • ファイル名の入力と検索、オートフィルタの実行ができない原因を教えていただきたいです。
回答を見る
  • ベストアンサー

VBAエラー

下のもので、 rangeクラスのselectメソッドが失敗しました　がでてしまいます。 ★★★のところで止まってしまいます。 1つ目のエクセルで、ファイル名を入力、検索して開き、8行目でオートフィルタをするマクロです。 オートフィルタのところで止まります。 どこが悪いのか、ご教授いただけませんでしょうか。 よろしくお願い致します。 Sub ファイルを開く() 　Dim str As String 　 Dim nCnt As Integer 　Dim sHozon As String 　Dim sFilename As String Dim Grp As String If Range("B2").Value <> "バーコード読み取り" Then '保存場所を指定 sHozon = "※※※" Grp = Right(Range("B2"), Len(Range("B2")) - InStr(Range("B2"), "F")) 'ファイル名を設定 sFilename = "AA" & Left(Range("B2"), 10) & ".xls" 'ファイルが存在しているか確認 str = sHozon & "\" & sFilename str = Dir(str) If (str <> sFilename) Then 'ファイルが存在しない場合、エラー MsgBox ("ファイルが存在しません") Else 'ファイルを開く Range("B2").Select Workbooks.Open sHozon & "\" & sFilename End If End If Workbooks(sFilename).Activate Sheets("B").Select ActiveSheet.Unprotect Workbooks(sFilename).Activate Rows("8:8").Select　　　★★★ Selection.AutoFilter ActiveSheet.Range("$A$8:$BL$1008").AutoFilter Field:=58, Criteria1:=Grp

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

  • ベストアンサー
  • kkkkkm
  • ベストアンサー率65% (1616/2455)
回答No.1

ActiveSheet.Rows("8:8").Select にしてみてはいかがですか。

kometoshi555
質問者

お礼

ありがとうございます。 とても早く教えていただけて、大変助かりました。 感謝します。

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. Excel（エクセル）

関連するQ&A

  • VBAのコードについて

    VBA初心者でございます。 以下のコードの後半（End If以降）でエラーがでてしまいます。 非常に乱暴な質問で大変恐れ入りますが、コードで気になる点などございますでしょうか？ もしございましたら、ご教示頂けますと幸いです。 どうぞ宜しくお願いいたします。 Sub 絞り込み() Dim i As Long Dim grp As String Dim newBookName As String Dim newBookPath As String Dim newBook As Workbook For i = 2 To 4 grp = Workbooks("test_master").Worksheets("grpリスト").Cells(i, 2) newBookName = Workbooks("test_master").Worksheets("grpリスト").Cells(i, 2) & ".xlsx" newBookPath = ThisWorkbook.Path & "\" & newBookName '指定したパスにファイルが作成済でないかを確認。 If Dir(newBookPath) = "" Then '新しいファイルを作成 Set newBook = Workbooks.Add '新しいファイルをVBAを実行したファイルと同じフォルダ保存 newBook.SaveAs newBookPath Else '既に同名のファイルが存在する場合はメッセージを表示 MsgBox "既に" & newBookName & "というファイルは存在します。" End If Workbooks("test_master").Worksheets("マスタ0701").AutoFilterMode = False With Workbooks("test_master").Worksheets("マスタ0701").Range(Cells(3, "B"), Cells(Rows.Count, "CK").End(xlUp)) .AutoFilter Field:=13, Criteria1:=grp '.CurrentRegion.Select Range(Cells(3, "B"), Cells(Rows.Count, "CK").End(xlUp)).SpecialCells(xlVisible).copy Workbooks(grp).Worksheets("Sheet1").Range("A1") '.AutoFilter End With Next i End Sub

  • VBA のコードについて

    すみません、以前にも同じようなご質問をさせて頂いたのですが、どうしても以下のマクロがうまく機能しません。 新しいブックは作成されるのですが、End If以降の検索結果が反映（コビー）されません。 コードに問題があるかアドバイス頂けますと幸いです。 どうぞ宜しくお願いいたします。 Sub sort() Dim i As Long Dim grp As String Dim newBookName As String Dim newBookPath As String Dim newBook As Workbook For i = 2 To 4 LOB = Workbooks("test").Worksheets("grpリスト").Cells(i, 2) newBookName = Workbooks("test").Worksheets("grpリスト").Cells(i, 2) & ".xlsx" newBookPath = ThisWorkbook.Path & "\" & newBookName '指定したパスにファイルが作成済でないかを確認。 If Dir(newBookPath) = "" Then '新しいファイルを作成 Set newBook = Workbooks.Add '新しいファイルをVBAを実行したファイルと同じフォルダ保存 newBook.SaveAs newBookPath Else '既に同名のファイルが存在する場合はメッセージを表示 MsgBox "既に" & newBookName & "というファイルは存在します。" End If With Workbooks("test").Worksheets("マスタ0701").AutoFilterMode = False With .Range(Cells(3, "B"), Cells(Rows.Count, "CK").End(xlUp)) .AutoFilter Field:=13, Criteria1:=grp '.CurrentRegion.Select Range(Cells(3, "B"), Cells(Rows.Count, "CK").End(xlUp)).SpecialCells(xlVisible).copy Workbooks(grp).Worksheets("Sheet1").Range("A1") '.AutoFilter End With End With Next i End Sub

  • ２０１３VBでオーバーフローエラー（２）

    よろしくお願いします。 前回の質問ではエラーの出た部分しか表示していなかった為、回答して頂いた方に 十分な情報が提供できずすみませんでした。 下記がエラーの出た部分までの全プログラムです。 Dim book1 As String 'ブック名1 Dim book2 As String 'ブック名2 Dim book3 As String 'ブック名3 Dim book4 As String 'ブック名4 Dim myday As Date Dim ITI1 As String 'アドレスの格納 Dim ITI2 As String 'アドレスの格納 Dim ITI3 As String 'アドレスの格納 Dim ITI4 As String 'アドレスの格納 Dim ITI5 As String Dim ITI6 As String Dim ITI7 As String Dim ITI8 As String Dim myRange As Range 'コードの個数 Dim myRange1 As Range Dim answer As Integer Dim bunki1 As Integer Dim c As Double 'カウント Dim n As Double 'カウント 'ワークブックの設定 Workbooks("A.xls").Activate book1 = Worksheets("ブックシート設定").Range("c3") 'コピー元 'book2 = Worksheets("ブックシート設定").Range("c5") book3 = Worksheets("ブックシート設定").Range("c7") 'A 'book4 = Worksheets("ブックシート設定").Range("c9") bunki1 = Worksheets("ブックシート設定").Range("c16") myday = Worksheets("ブックシート設定").Range("c14") 'コピー元非表示を表示にする Workbooks(book1).Activate Sheets("B").Select Sheets("B").Select Columns("G:J").Select Selection.EntireColumn.Hidden = False Columns("j:q").Select Selection.EntireColumn.Hidden = False 'コードの個数を数える Workbooks(book1).Activate Sheets("B").Select ITI4 = Range("b65536").End(xlUp).Address '----b列の最終行から上方向の終端セルを選択 Set myRange = Worksheets("B").Range("b6", ITI4) answer = Application.WorksheetFunction.Count(myRange) Set myRange1 = Worksheets("B").Range("e8") For c = 1 To answer 'データー個数のカウント If myRange1.Offset(c) = myday Then n = n + 1 Next 'オーフィルターの設定 Workbooks(book1).Activate Sheets("B").Select ITI1 = Range("b65536").End(xlUp).Address '----b列の最終行から上方向の終端セルを選択 ITI7 = Range(ITI1).Offset(, 11).Address Range("a8", ITI7).AutoFilter FIELD:=5, Criteria1:=Format(myday,"yyyy/m/d") >>>>>ここでオーバーフローエラー 前回指摘されたCriteria1:=mydayをCriteria1:=Format(myday,"yyyy/m/d") に追加変更しました。 読みにくいかもしれませんがよろしくお願いします。

  • VBAでの行削除について

    教えてください。 現在、VBAを使用して、CSVファイルの編集をしたいと考えています。 フォルダ内に数個のCSVファイルがあり、それらにすべて同じ処理（行削除など）をしたいのです。 下記のようなプログラムです。 Sub getting() Dim myPath As String Dim myFName As String Dim FCnt As Integer Dim A(500) As String MsgBox CurDir() Workbooks("自動処理.xls").Activate myPath = ActiveWorkbook.Path MsgBox myPath ChDir myPath FCut = 0 myFName = Dir("*.csv") If myFName <> "" Then FCut = FCut + 1 A(FCut) = myFName Do myFName = Dir() If myFName <> "" Then FCut = FCut + 1 A(FCut) = myFName MsgBox A(FCut) Else Exit Do End If Loop End If MsgBox "「" & myPath & "」には、" & FCut & "個のファイルがあります。" Dim i As Integer Dim seet As String Dim ws As Object Dim FullPath As String For i = 1 To 1 seet = Left(A(1), 6) FullPath = myPath & "\" & A(i) 'Workbooks.Open(FullPath).Activate Open FullPath For Append As #1 Print #1, Rows("1:1").Select Selection.Delete Shift:=xlUp Rows("2:2").Select Selection.Delete Shift:=xlUp Range("A1").Select Print #1, Range("A1").Value = "" Print #1, Range("A1").Value = "COMP_NAME" Print #1, Range("B1").Select Print #1, ActiveCell.Value; "PC_OS" Print #1, Range("C1").Select Print #1, ActiveCell.Value = "OS_SUB_VERS" Print #1, Range("D1").Select Print #1, ActiveCell.Value = "IP_ADDR" Print #1, Range("E1").Select Print #1, ActiveCell.Value = "LOCATION " Close #1 ' Workbooks(A(i)).Save ' Workbooks(A(i)).Close savechanges:=False 　Next i End Sub 教えていただきたいのは、どうにかworkbook.openを使わず、ファイルを編集できるところまでいったのですが、ファイルを開かずに行を削除することができません。 　　＞Print #1, Rows("1:1").Select ＞Selection.Delete Shift:=xlUp ＞Rows("2:2").Select ＞Selection.Delete Shift:=xlUp ファイルを開かずに行削除をできるものなのでしょうか。 ご存知の方がいれば教えてください。 よろしくお願いいたします。

  • EXCEL VBA 　任意のシートに貼りつけ

    御世話になります。おしえて下さい。 データPCのexcelデータからオートフィルタでデータを抽出して任意の列を 抽出するところまでは出来ているようですが、その先が付け焼刃ですので、 さっぱり解決策がみつけられません。 データをオートフィルタにて抽出→帳票ブックの任意のシートに張り付け 帳票のシート名はユーザフォームのリストボックスから代入してるつもりです。 宜しくお願い致します。 Option Explicit Sub Macro3_2() Dim myRL As Date Dim MyRow As Long Dim Window1 As Window Dim buf As String myRL = UserForm1.TextBox1 buf = UserForm1.ListBox1 Workbooks.Open Filename:= _ "\\WPCABC\Users\hoge\Documents\hogehoge\データ.xlsx" ActiveSheet.ListObjects("テーブル_PCABC_からのクエリ") _ .Range.AutoFilter Field:=9, _ Criteria1:="=" & myRL ActiveSheet.ListObjects("テーブル_PCABC_からのクエリ") _ .Range.AutoFilter Field:=12, _ Criteria1:=">=1" MyRow = Worksheets("sheet1") _ .Range("A" & Rows.Count).End(xlUp).Row Worksheets("sheet1").Activate Range("B2:B" & MyRow).Select Selection.Copy ------------------------------------------------------↓上手く出来ません Workbooks("帳票.xlsm").Worksheets("buf") _ .Range("Y3" & MyRow) _ .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Workbooks("帳票.xlsx").Worksheets("sheet1").Activate Range("L2:L" & MyRow).Select Selection.Copy Workbooks("帳票.xlsm").Worksheets("buf") _ .Range("Z3" & MyRow) _ .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Set Window1 = Application.Windows("クエリデータ.xlsm") Window1.Activate End Sub

  • エクセルVBAで指定したセルへジャンプするコード(追加の追加質問です)

    http://oshiete1.goo.ne.jp/qa2903797.html たびたびすみません。最後にひとつだけお願いします。 お教えいただいた下のコードは順調に動作するのですが、 対象セルが結合セルの場合、エラーが出てしまいます。 とまってしまうコードの部分は With Selection.AddComment です。 エラーメッセージにはプロシージャの呼び出し、 または引数が不正です。(Error 5)と書いてあります。 結合セルは動作しないものでしょうか？ Sub test01() Dim x As String Dim ThisSheet_Name As String Dim Sheet_Name As String Dim Range_Name As String Dim I As Integer, n As Integer Dim Ans As Integer Dim myComment As String '新規追加 Dim Colors As Integer '新規追加 ThisSheet_Name = ActiveSheet.Name '設定シート Select Case Workbooks.Count Case 1 MsgBox "チェックするファイルがありません。" Exit Sub Case 2 For n = 1 To 2 If Workbooks(n).Name <> ThisWorkbook.Name Then x = Workbooks(n).Name '開いている“もうひとつのブック”の名前 End If Next Case Else MsgBox "他に開いているファイルが複数のため対象を特定できません。" Exit Sub End Select I = 0 Do While (1) With ThisWorkbook.Sheets(ThisSheet_Name) If .Range("A3").Offset(I, 0).Value = "" Then MsgBox "検査項目は以上です。" ThisWorkbook.Activate Exit Do 'A列の３行目以下が、空白なら終わる End If Sheet_Name = .Range("A3").Offset(I, 0).Value Range_Name = .Range("B3").Offset(I, 0).Value myComment = .Range("C3").Offset(I, 0).Value End With Windows(x).Activate Sheets(Sheet_Name).Select Range(Range_Name).Select Colors = Selection.Interior.ColorIndex '新規追加 Selection.Interior.ColorIndex = 6 With Selection.AddComment .Visible = True .Text myComment End With Range(Range_Name).Select Ans = MsgBox("「次をチェックしますか？」", vbYesNo) Selection.Interior.ColorIndex = Colors '修正 Selection.ClearComments '新規追加 If Ans = vbYes Then I = I + 1 Else Exit Do End If Loop End Sub

  • vbaの繰り返し処理について

    vbaです。 Sub Test1() Dim Str As String Dim Pnt1 As Long Dim Pnt2 As Long Str = Range("A1") Pnt1 = InStr(Str, "重 http://") If Pnt1 <= 0 Then Exit Sub Pnt2 = InStr(Pnt1, Str, "要") If Pnt2 <= 0 Then Range("B1") = Mid(Str, Pnt1 + 2) Else Range("B1") = Mid(Str, Pnt1 + 2, Pnt2 - (Pnt1 + 2)) End If End Sub という式でA1からA2.A3と下にURLが入っており空欄になるまで同じ処理をしたいのですがどのように変更すれば作動しますでしょうか？

  • ＶＢＡオートフィルターの使い方

    ＶＢＡオートフィルターの使い方 情報_test.xlsに存在する氏名をキーワードとして抽出し別のファイルに貼り付ける操作をAutoFilterを使用して実行コードを記述しました。filterまでは機能するようですが、別のファイルに貼り付けるところがうまく機能していないようです。実行させるとエラーにはならず、貼り付け先シートが空白のままになっています。どこに間違いがあるのでしょうか。 Sub Macro14() ' Application.ScreenUpdating = False ' Dim jikkou As Integer Dim mymsg As String jikkou = MsgBox("このエクセルファイルに集約された情報をもとに担当者毎の入力ファイルを作成します。既存のファイルが更新されます。", vbYesNo) Select Case jikkou Case vbYes ' Workbooks.Open "S:￥情報入力ファイル￥情報_高橋.xls" ActiveSheet.Unprotect ActiveSheet.Cells.Clear ' 'オートフィルターで担当者別に情報を抽出しそれぞれのファイルに書き出す ' Workbooks("情報_test.xls").Worksheets("情報入力").Range("A1").AutoFilter _ field:=14, Criteria1:="高橋" Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _ Workbooks("情報_高橋.xls").Worksheets("情報").Range("A1") End Select End Sub

  • 【マクロ】指定したファイルを開いてマクロを実行

    マクロ初心者です。よろしくお願いします。 ＜質問＞ コマンドボタンをクリックしたら、任意のエクセルファイルを指定して開き、その開いたファイル(白紙状態のファイル)にマクロを実行させる方法を探してます。 ＜作成マクロ＞ Private Sub CommandButton1_Click() Dim OpenFileName As String OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls") If OpenFileName <> "False" Then Workbooks.Open OpenFileName End If Workbooks(Dir(OpenFileName)).Activate ActiveCell.FormulaR1C1 = "テスト" Range("A1").Select Selection.Copy Range("B1").Select ActiveSheet.Paste End Sub ＜マクロ説明＞ --コマンドボタンをクリックして指定したエクセルファイルを開く-- Private Sub CommandButton1_Click() Dim OpenFileName As String OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls") If OpenFileName <> "False" Then Workbooks.Open OpenFileName End If Workbooks(Dir(OpenFileName)).Activate --開いたエクセルファイル(白紙状態)のセルA1に「テスト」を入力した後、コピーしセルB2に貼り付ける-- 　 ActiveCell.FormulaR1C1 = "テスト" Range("A1").Select Selection.Copy Range("B1").Select ActiveSheet.Paste End Sub コマンドボタンをクリック ↓ 任意のエクセルファイルを指定して開く ↓ 開いたファイル(白紙状態のファイル)のセルA1に「テスト」と書き込み セルA1の「テスト」をコピーしセルB1に貼り付ける このマクロを実行させるにはどこを改善すれば良いでしょうか？ ご助言いただけると助かります。 よろしくお願い致します。

  • 【マクロ】指定したファイルを開いてマクロを実行

    マクロ初心者です。よろしくお願いします。 ＜質問＞ コマンドボタンをクリックしたら、任意のエクセルファイルを指定して開き、その開いたファイル(白紙状態のファイル)にマクロを実行させる方法を探してます。 ＜作成マクロ＞ Private Sub CommandButton1_Click() Dim OpenFileName As String OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls") If OpenFileName <> "False" Then Workbooks.Open OpenFileName End If Workbooks(Dir(OpenFileName)).Activate ActiveCell.FormulaR1C1 = "テスト" Range("A1").Select Selection.Copy Range("B1").Select ActiveSheet.Paste End Sub ＜マクロ説明＞ --コマンドボタンをクリックして指定したエクセルファイルを開く-- Private Sub CommandButton1_Click() Dim OpenFileName As String OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls") If OpenFileName <> "False" Then Workbooks.Open OpenFileName End If Workbooks(Dir(OpenFileName)).Activate --開いたエクセルファイル(白紙状態)のセルA1に「テスト」を入力した後、コピーしセルB2に貼り付ける-- 　 ActiveCell.FormulaR1C1 = "テスト" Range("A1").Select Selection.Copy Range("B1").Select ActiveSheet.Paste End Sub コマンドボタンをクリック ↓ 任意のエクセルファイルを指定して開く ↓ 開いたファイル(白紙状態のファイル)のセルA1に「テスト」と書き込み セルA1の「テスト」をコピーしセルB1に貼り付ける このマクロを実行させるにはどこを改善すれば良いでしょうか？ ご助言いただけると助かります。 よろしくお願い致します。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

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

質問する