- ベストアンサー
ＶＢＡを始めたばかりです。
ＶＢＡを始めたばかりです。 下記でエラー「オブジェクトが必要です」が出ます。 何故ですか。 Sub A_Sample048() Dim mySht1 As Object Dim mySht2 As Worksheet '準備ここまで Set mySht1 = ActiveSheet If mySht1.Type = xlWorksheet Then Set mySht2 = mySht1 MsgBox mySht2.Name Else MsgBox "最前面のシートはワークシートではありません" End If Set mySht1 = Nothing 'オブジェクトの解放 Set mySht2 = Nothing End Sub よろしくお願いします。
- whatkindofadice
- お礼率28% (9/32)
- Visual Basic
- 回答数2
- ありがとう数7
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
ツールバーの参照設定を開いてみてください。 「不可」という参照があれば、それを外します。 もし、なければエラーの出るステートメントを 示してください。
その他の回答 (1)
- nda23
- ベストアンサー率54% (777/1415)
おそらくActiveSheetが確定していない状態だと 思いますが、Excelは何を使っているんでしょう？ とりあえず、エラーハンドリングして処置します。 Dim エラー As Long On Error Resume Next Set mySht1 = ActiveSheet エラー = Err.Number On Error GoTo 0 If エラー <> vbNormal Then MsgBox "シートを選択してください" Exit Sub End If
関連するQ&A
- ブック全体の検索の次へは？
ブック全体を検索するマクロ作ったのですが、 ブックの最初にあるものしか見つけられません。 見つかった時に、次の検索を行うにはどのようなＶＢＡになるのでしょうか？ よろしくお願いもうしあげます。 Sub KensakuAll() 'ブック内の全シートを検索 Dim myWb As Workbook Dim mySht As Worksheet Dim myRng As Range Dim Key1 As String Key1 = InputBox("検索キーを入力しなさい") If Key1 = "" Then Exit Sub For Each mySht In Sheets Set myRng = mySht.Cells.Find(what:=Key1) If Not myRng Is Nothing Then mySht.Activate myRng.Activate Set mySht = Nothing Set myRng = Nothing Exit Sub End If Next MsgBox "該当するセルは見つかりませんでした" Set mySht = Nothing Set myRng = Nothing End Sub
- ベストアンサー
- オフィス系ソフト
- VBA シートプログラムでRangeエラー
いつもお世話になっております。 Excel2003を使用しております。 シートに直接プログラムを書いています。 （例として、Sheet1とします） シートの内容が変わったときに、色々プログラムを実行していこうと思っているのですが、 Private Sub Worksheet_Change(ByVal Target As Range) のTargetが上手く取得できていない気がします。 今までは上手く動いていたのですが、 急にTargetの値に数値（セルに入力した値）が入ってしまうようになり 上手く組めなくて困っています。 Private Sub Worksheet_Change(ByVal Target As Range) Dim 開始1 As Range Dim 終了1 As Range Dim 開始2 As Range Dim 終了2 As Range Set 開始1 = Range("D5：D63") Set 終了1 = Range("E5：E63") Set 開始2 = Range("F5：F63") Set 終了2 = Range("G5：G63") If ThisWorkbook.ActiveSheet.ProtectContents Then '保護かかってたら End '強制終了 End If If Not Application.Intersect(Target, 開始1) Or Application.Intersect(Target, 実績日開始2) Is Nothing Then Call 開始(Target, 開始1, 開始2) ElseIf Not Application.Intersect(Target, 終了1) Or Application.Intersect(Target, 終了2) Is Nothing Then Msgbox "テスト！" End If End Sub '----------------------------------------------- Sub 開始(ByVal Target As Range, 開始1 As Range, 開始2 As Range) If Not Application.Intersect(Target, 開始1) Is Nothing Then MsgBox Target.Row End If If Not Application.Intersect(Target, 開始2) Is Nothing Then MsgBox Target.Row + 1 End If End Sub 全部シートに書いています。 まだ、テスト段階のため適当なプログラムしか書いておりません。 （指定範囲が変更された場合に、Msgboxを出したりなど 単純なことしかしていません） どこが悪いのか、教えて頂けないでしょうか？ よろしくお願い致します。
- ベストアンサー
- Excel（エクセル）
- VBA オートフィルタで抽出したものを連続貼り付け
下記のように情報が１００近くまで存在した場合に、オートフィルターで一つずつ抽出したものをコピーし、新規シートに貼り付けたいのですが、どうすれば良いのでしょうか？ １ １ １ ２ ２ ２ ３ ３ ３ たとえばシート１に １ １ １ シート２に ２ 2 2 といったように処理したいので、教えて下さい。 ｖｂａの参考書とサンプルを見て下記のように作成したのですが上手くいきません。 どんな本を読めば作成出来るようになるのかわからず、質問させていただきました。 ub オートフィルター() Dim myRng As Range Dim mySht As Worksheet Set myRng = _ Worksheets(1).Range("A1").CurrentRegion With Worksheets Set mySht = .Add(after:=.Item(.Count)) End With With myRng .AutoFilter field:=1, Criteria1:=8 On Error Resume Next .Resize(.Rows.Count - 1).Offset(1).Copy mySht.Range("A1") .SpecialCells(xlCellTypeVisible).Copy mySht.Range("A1").AutoFilter mySht.Range("A1").AutoFilter If Err.Number <> 0 Then Application.DisplayAlerts = False mySht.Delete Application.DisplayAlerts = True End If On Error GoTo 0 End With Set myRng = Nothing Set mySht = Nothing End Sub
- 締切済み
- その他MS Office製品
- エクセルVBAで、IEからコピーするには
エクセル2000,win2000,IE6です。 次のような、コードを書きました。 Sub t03ccc() Dim objIE As Object 'IE オブジェクト参照用 Dim objShell As Object 'Shell オブジェクト参照用 Dim objWindow As Object 'Window オブジェクト参照用 Set objShell = CreateObject("Shell.Application") For Each objWindow In objShell.Windows '起動中のタイトルを探して。 If Left(objWindow.document.Title, 7) = "Office系" Then Set objIE = objWindow 'オブジェクトを代入 Msg = "Office系" Exit For End If Next If Msg <> "Office系" Then MsgBox "・・・スクリーニング結果一覧・・・がありません" Exit Sub End If objIE.ExecWB 17, 0 'OLECMDID_SELECTALL = 17 全てを選択 objIE.ExecWB 12, 0 'OLECMDID_COPY = 12 コピー Sheets("Sheet3").Select Rows("1:200").ClearContents Range("A1").Select ActiveSheet.Paste '''' objIE.Quit Set objIE = Nothing Set objShell = Nothing Set objWindow = Nothing End Sub これで、エクセルとIEしか開いてないときは巧くいくのですが、 エクスプローラーを同時に開くと実行時エラー438が出ます。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- 変数の値を破棄する方法
データ型で宣言した場合、 変数の値はどうやって破棄すればいいのでしょうか？ 例えば、標準モジュールに Option Explicit Dim s As String Dim w As Worksheet Sub test() Set w = ActiveSheet s = "sss" MsgBox w.Name MsgBox s Set w = Nothing s = Nothing End Sub とした場合、 s = Nothingがエラーになります。 オブジェクト型で宣言したら、 Set ●= Nothing で破棄しますが、 データ型で宣言した場合の正しい破棄の仕方を教えてください。 今回の例は、モジュールレベルのdimステートメント で宣言しているため、プロシージャーが終わっても 値を保持しています。
- ベストアンサー
- オフィス系ソフト
- エクセルＶＢＡのＦＩＮＤの質問です。
エクセルＶＢＡのＦＩＮＤの質問です。 シート１ A B C D 1 コード１ コード２ コード３ 名 称 2 4 1 1 3 4 2 2 4 4 3 1 シート２ A B 1 コード１ 名 称 2 1 名称１ 3 2 名称２ やりたいことは、シート１のＤ列に、シート１のコード３をもとにシート２から名称を取得したいのです。 下記に記したプログラムだと最初のＦＩＮＤＮＥＸＴは動くのですが、 2回目でエラーになってしまい、次を読んでくれません。 どなたか、ご教授頂けますでしょうか。 シート１の検索条件はコード１の"4"です。 シート１のコード１は重複キーで、一レコードずつ読んで行き、各レコード毎にシート２を読みたい のです。 Dim シート1 As Worksheet Dim シート2 As Worksheet Dim obj As Object Dim Lin As Integer Dim mykey As Integer Dim obj1 As Object Dim Lin1 As Integer Dim mykey1 As Integer Dim st_Lin As Integer Set シート1 = ThisWorkbook.Worksheets("シート１") Lin = シート1.Cells(シート1.Rows.Count, 1).End(xlUp).Row mykey = "4" Set obj = シート1.Range("A1", "A" & Lin).Cells.Find(What:=mykey, _ LookIn:=xlValues, _ lookat:=xlWhole, _ SearchOrder:=xlByColumns) If obj Is Nothing Then MsgBox ("異常です") Exit Sub Else st_Lin = obj.Row Do Until obj.Row <> st_Lin Set obj = シート1.Range("A1", "A" & Lin).FindNext(obj) If obj Is Nothing Then Exit Do Else Set シート2 = ThisWorkbook.Worksheets("シート２") With シート2 Lin1 = .Cells(シート2.Rows.Count, 1).End(xlUp).Row mykey1 = シート1.Cells(obj.Row, 3).Value Set obj1 = .Range("A1", "A" & Lin1).Cells.Find (What:=mykey1,LookIn:=xlValues,lookat:=xlWhole,SearchOrder:=xlByColumns) If obj1 Is Nothing Then MsgBox ("名称取得できませんでした") Exit Sub Else シート1.Cells(obj.Row, 4).Value = .Cells(obj1.Row, 2).Value End If End With End If Loop End If
- ベストアンサー
- その他（プログラミング・開発）
- VBAでWebに値を入力
VBAでWebに値を入力する操作を考えています。 エクセルシートのA1に入っている値をWeb上に入力する操作なのですが、 以下のコードを実行すると「AllLog.keyword.Value = t」の部分でエラーになります。 googleではkeywordのところを「q」、yahooではkeywordのところを「p」にすれば問題ないのですが、 神奈川中央交通のページではエラーになってしまいます。 なぜですか？？ Sub google() Dim objIE As InternetExplorer '参照設定:Microsoft Shell Controls and Automation Dim objShell As Shell Dim WinFlg As Boolean Dim objWin As Object Dim AllLog As Object On Error GoTo EndProcess Set objShell = New Shell For Each objWin In objShell.Windows If TypeName(objWin) = "IWebBrowser2" Then WinFlg = True Set objIE = objWin Exit For End If Next Set objShell = Nothing If WinFlg = False Then MsgBox "IEオブジェクトが取得できません", vbCritical Exit Sub End If EndProcess: If Err() > 0 Then MsgBox Err.Description End If With objIE Set AllLog = .Document.all t = Cells(1, 1) AllLog.keyword.Value = t End With Set objIE = Nothing End Sub
- ベストアンサー
- Visual Basic
- VBAで、デバッグをお願いします。
作りたいプログラムはpartsno_01から、partsno_20までのテキストボックスに、エクセルのセルA1から、A20までにある製品番号を入力し、データをsubmitするものです。 Sub pn() Dim ObjIE As Object Dim ObjShell As Object Dim ObjWindow As Object Dim WinExist As Boolean WinExist = False Set ObjShell = CreateObject("Shell.Application") For Each ObjWindow In ObjShell.Windows If TypeName(ObjWindow.document) = "HTMLDocument" Then WinExist = True Set ObjIE = ObjWindow End If Next Set ObjShell = Nothing If Not WinExist = True Then MsgBox "製品番号検索を開いてください。" Exit Sub End If ObjIE.Visible = True Do While i < 21 i = 1 Set elements = ObjIE.document.getElementsByName("partsno_0" & "i") If elements Is Nothing Then Exit Sub End If elements.Item(0).Value = Worksheets(1).Cells(i, 1).Value i = i + 1 Loop End Sub で、 elements.Item(0).Value = Worksheets(1).Cells(1, 1).Value が常にエラーになります。 間違っていはいないと思うんですが・・・・。 何がいけないのでしょうか。
- ベストアンサー
- その他（プログラミング・開発）
- VBA どうしてなのでしょうか？
どうしてなのかまったくわかりません… Sub test() Dim TW As Worksheet Set TW = Worksheets("Sheet2") TW.Activate Range("G5").Activate End Sub は良いのに Sub test() Dim TW As Worksheet Set TW = Worksheets("Sheet2") TW.Range("G5").Activate End Sub はエラーがでます… この理由をご存知の方いらっしゃいますか？？ よかったら教えていただけませんか？
- ベストアンサー
- Visual Basic
- VBAがとまります。
フォルダ内の全てのエクセルデータを一つにまとめたいのですが、 下記を実行すると、『実行時エラー1004 アプリケーション定義またはオブジェクト定義のエラーです。』のメッセージが出て先に進みません。対象のデータを開いて実行しても同様でした。 調べましたがよくわかりませんので、ご教示いただけませんでしょうか。 基本的なところかもしれませんが、よくわかりません。 どうぞよろしくお願いいたします。 ------------------------------------------------------- 'プログラム1｜プログラム開始 Sub GetExcelDataInFolder() 'プログラム2｜シート設定 Dim ws1 As Worksheet Set ws1 = ThisWorkbook.Worksheets("Sheet1") 'プログラム3｜FileSystemObjectの設定 Dim fs As FileSystemObject Set fs = New FileSystemObject 'プログラム4｜対象フォルダを取得 Dim myfolder As Folder Set myfolder = fs.GetFolder(ThisWorkbook.Path) 'プログラム5｜対象フォルダ内の全ファイルを処理 Dim myfile As File For Each myfile In myfolder.Files 'プログラム6｜拡張子が「xlsx」のファイルのみを処理 If fs.GetExtensionName(myfile) = "xlsx" Then 'プログラム7｜フォルダ内のエクセルを開いてシートを設定 Dim wb As Workbook Set wb = Workbooks.Open(Filename:=myfile) Dim ws2 As Worksheet Set ws2 = wb.Worksheets(1) 'プログラム8｜開いたエクセルの最終行を取得 Dim cmax As Long cmax = ws2.Range("A65536").End(xlUp).Row Debug.Print myfile.Name & "のcmax=" & cmax 'プログラム9｜開いたエクセルのデータを転記 Dim i As Long For i = 2 To cmax Dim cmax1 As Long cmax1 = ws1.Range("A65536").End(xlUp).Row ws1.Range("A" & cmax1 + 1 & ":E" & cmax1 + 1).Value = ws2.Range("A" & i & ":E" & i).Value Next 'プログラム10｜エクセルを閉じる wb.Close 'プログラム11｜オブジェクト解放 Set ws2 = Nothing Set wb = Nothing End If Next 'プログラム12｜エクセルを保存 ThisWorkbook.Save 'プログラム13｜オブジェクト解放 Set myfolder = Nothing Set fs = Nothing 'プログラム14｜プログラム終了
- 締切済み
- Visual Basic
補足
回答有難うございます。 ツールバーから「参照設定」が見つからないのですが・・・・ Set mySht1 = ActiveSheet でエラーが発生します。 sheetを選択してから、マクロ実効をすると起こらないようです。 １）ボタンを配置して、それから起動するようにしたいが、 デザインからの操作がいまいちです。 ２）事前に、「シートを選択してください」なるメッセージを でるようにしたいのですがどうすればいいでしょうか。