• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:複数該当の検索処理でエラーになる(オブジェクト変数または With ブロック変数が設定されていません))

複数該当の検索処理でエラーになる(オブジェクト変数または With ブロック変数が設定されていません)

fumufumu_2006の回答

回答No.2

>findを複数回行うのはだめなんですね。 FindNext使わなければいいんです。 >あまりお勧めでない・・・のはなぜでしょうか。。。 FindNextのためにダミーのFind入れるなら、最初から検索範囲のRange("A1:A37")を変数にして、最初はRange("A1:A37")、次はRange("A" & 前に見つかった行+1 &":A37")・・・とした方がいいかなと思ったんです。 それより、Find使わない方法もあります。 でも、あせって変更して動かなくなるより、ANo.1が原因なら、てっとり早い対処なのでと思ったんです。 まずは納期ですよね、やっぱり。

関連するQ&A

  • VBAオブジェクト変数またはWithブロック変数

    Access VBAについてお教えください。 VBAを使用しています。下記のようなコードでDOMの値を取得しようと思っています。 If IsNull(IE.Document.getElementsByTagName("table").Item(1).rows(1).cells(0).innerText) Or _ IE.Document.getElementsByTagName("table").Item(1).rows(1).cells(0).innerText = "" Then stocker = "" Else stocker = IE.Document.getElementsByTagName("table").Item(1).rows(1).cells(0).innerText End If IE.Document.getElementsByTagName("table").Item(1).rows(1).cells(0).innerText)にデータがある場合は、 問題なくstockerに値をセットすることができます。 ただし、IE.Document.getElementsByTagName("table").Item(1).rows(1).cells(0).innerText)にデータ(要素)が なにも無い場合は、エラーが発生します。 「実行時エラー91;オブジェクト変数またはWithブロック変数が設定されていません」 IE.Document.getElementsByTagName("table").Item(1).rows(1).cells(0).innerText)にデータが無い場合は、NULLが 帰ってくるとサイトで見かけたので、IF文を使って回避しようと思いましたが、成功しませんでした。 何が悪いと考えられるでしょうか?

  • オブジェクト変数またはWithブロック変数が設定されていません

    はじめまして質問させていただきます。 Webページからコピー&ペーストしたものを必要な情報だけ 抜き出すものを作成中です。 1ページ目は成功していますが 2ページ目の objIE.Navigate url の行で 実行時エラー'91' オブジェクト変数またはwithブロック変数が設定されていません。とでてしまします。 解決策をご教授お願いします。 Dim objIE As Object Dim url As String Dim tai As String Dim aku As String Dim uot As String Dim i As Integer Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = True x = 1 For i = 1 To 20 url = Worksheets("データ").Range("E" & i) objIE.Navigate url Do If objIE.Busy = False And objIE.readyState = 4 Then Exit Do Loop objIE.ExecWB 17, 0 objIE.ExecWB 12, 0 Sheets.Add ActiveSheet.Name = "1" Range("A1").Select ActiveSheet.PasteSpecial Format:="テキスト" objIE.Quit: Set objIE = Nothing tai = Worksheets("1").Range("A13") aku = Worksheets("1").Range("A63") uot = Worksheets("1").Range("A64") Worksheets("データ").Select Range("A" & i) = tai Range("B" & i) = aku Range("C" & i) = uot Application.DisplayAlerts = False Worksheets("1").Delete Application.DisplayAlerts = True Next i

  • マクロ オブジェクト変数Withブロック変数エラ-

    以前、こちらでインターネット上の窓にエクセルの数値を自動で入れたいと言う質問をさせて頂きました。http://okwave.jp/qa/q7676012.html VBAを利用したらどうかと教えていただき、マクロをその後、勉強し動いて感動しました。 クロネコの宅急便サイトで応用しようと試みたのですが、「オブジェクト変数またはWithブロック変数が設定されてません。」とエラーが出ます。 同じ仕組みだと思うのですが何がいけないんでしょうか? Dim myWindow As Object Dim myUrl As String myUrl = "http://toi.kuronekoyamato.co.jp/cgi-bin/tneko?init For Each myWindow In CreateObject("Shell.Application").Windows With myWindow If .LocationURL = myUrl Then .document.getElementById("text1").value = Range("A1").value .document.getElementById("text2").value = Range("A2").value .document.getElementById("text3").value = Range("A3").value .document.getElementById("text4").value = Range("A4").value .document.getElementById("text5").value = Range("A5").value Exit For End If End With Next myWindow

  • エクセル 最終行からの連続コピー

    エクセルで最終行から上に連続する10行(最終行含む)をコピーしたいです。 途中、空白行が含まれている場合でも、最終行を特定し、コピーできるようにするには、下記のコードにどう手を加えたらよいでしょうか? どなたかアドバイスをお願いします。 Sub Test()   Dim i As Long   Dim j As Integer   Dim rng As Range   With ActiveSheet     'フィルタ     .Range("A1").CurrentRegion.AutoFilter Field:=1          '行選択     With .AutoFilter.Range       For i = .Cells(.Cells.Count).Row To 2 Step -1         If .Rows(i).Hidden = False Then           If rng Is Nothing Then             Set rng = .Rows(i)           Else             Set rng = Union(rng, .Rows(i))           End If           j = j + 1         End If         If j >= 10 Then Exit For       Next i       'コピー       If Not rng Is Nothing Then         rng.Copy Worksheets("Sheet2").Range("A1")         Beep       Else         MsgBox "該当行は存在しません。", 48       End If     End With   End With   Set rng = Nothing なお、コードはこちらを参考にさせていただきました。 http://okwave.jp/qa3552420.html?ans_count_asc=1

  • エクセル 最終行からの連続コピー

    * すぐに回答を! エクセルC20からI51までデータを1日1行ずつ入力します。 データが入力されている最終行から上に連続する10行(最終行含む)をコピーしたいのですが、最終行から10行上をどのように認識させたらいいのか、わかりません。Offsetなど試してみましたがダメでした。 よろしくお願いします。 Sub dataコピー() Dim i As Long Dim j As Integer Dim rng As Range '最後尾から10行前までを選択 With Worksheets("月").Range(Cells(20, 3), Cells(51, 10)) For i = Cells(Rows.Count, 1).End(xlUp).Row To -10? If rng Is Nothing Then Set rng = .Rows(i) End If j = j + 1 If j >= 10 Then Exit For Next i 'コピー If Not rng Is Nothing Then rng.Copy Range("M1") Beep Else MsgBox "該当行は存在しません。", 48 End If End With Set rng = Nothing End Sub コードはこちらを参考にしました ​http://questionbox.jp.msn.com/qa5440189.html

  • VBAエラー:オブジェクト変数またはWithブロック変数が設定されていません。

    Book1.xlsのSheet1~Sheet8を選択し、それらのシート内から、ABCDEFGという文字検索をさせたいのですが、実行させると「実行時エラー'91':オブジェクト変数またはWithブロック変数が設定されていません。」というエラーとなってしまいます。 マクロの記録で作成したマクロを元にしているので、コードがおかしいとは思えないのですが・・・ どなたか、解決策を、ご教授下さいませ。 よろしくお願い致します。 ------------------ Sub TEST() Workbooks("Book1.xls").Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8")).Select Cells.Find _ (What:="ABCDEFG", _ After:=ActiveCell, _ LookIn:=xlFormulas, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False, _ MatchByte:=False, _ SearchFormat:=False).Activate End Sub

  • VBSエラー"オブジェクト型の変数は定義されていません"について(2)

    こんばんは。よろしくお願いします。 CreatePages1は、あるルートフォルダ(rtFolder)にトップページ"index.html"をつくり(または上書きし)、そのルートフォルダの中にひとつだけあるフォルダ(sbFolder)以下のすべての階層のすべてのフォルダの中に存在する、拡張子がabc(仮称)のファイルと同じ名前のhtmlファイルを、abcファイルと同じフォルダに同じ数だけつくり(または上書きし)、トップページ"index.html"にその作成したすべてのhtmlファイルへのリンクを表示させる、という構想で作成中のVBSなのですが、これを実行すると「●(マル)」と書いた20行目のところでエラー「オブジェクト型の変数は定義されていません」となってしまいます。その前のEchoの結果は望みどおりになっていると思います。このエラーをどのように対処すればよいかを教えていただければと思います。 注)rtFolderにabcファイルはありません。 私はExcelのVBAは多少の経験がありますが、VBScriptを書いたのはこれが初めてで、HTMLも未経験です。 aSearchPatternに"*.abc"を代入したのに、▲(さんかく)と書いた行で拡張子"abc"を指定してしまっているのは、こうしないと全てのファイルについてhtmlファイルが作成されそうだったからです。よろしければ、このことも含めてご回答よろしくお願いします。 Option Explicit Public fso, CurFolder, indexPageTS, otherPageTS, rtFolder, sbFolder, sbFolder2, _ dataFolder, aSearchPattern, aFiles, FileItem, currentFolder, Ext Set fso = WScript.CreateObject("Scripting.FileSystemObject") Set CurFolder = fso.GetFolder(".") Call CreatePages1(CurFolder, "*.abc", aFiles) Set CurFolder = Nothing Set fso = Nothing 'サブフォルダへの処理 Public Sub SearchSubFolder1(ByVal sbFolder) Set fso = WScript.CreateObject("Scripting.FileSystemObject") For Each sbFolder2 In sbFolder.SubFolders WScript.Echo sbFolder WScript.Echo sbFolder2 ●(マル) If sbFolder2 <> "" Then Call CreatePages1(sbfolder2, aSearchPattern, aFiles) '再帰呼び出し If sbFolder2 <> "" Then Call SearchSubFolder1(sbFolder2) End If End If Next 'オブジェクトの開放。 Set sbFolder2 = Nothing Set fso = Nothing End Sub 'htmlファイル作成 Public Sub CreatePages1(ByVal rtFolder, ByVal aSearchPattern, ByRef aFiles) Set fso = WScript.CreateObject("Scripting.FileSystemObject") 'トップページを途中まで作成する。 Set indexPageTS = fso.CreateTextFile(rtFolder.Path & "\index.html", True) indexPageTS.WriteLine "<HTML>" (中略) 'データフォルダに各htmlファイルを作成する。 For Each dataFolder In rtFolder.SubFolders If dataFolder <> "" Then For Each FileItem In dataFolder.Files If FileItem <> "" Then Ext = fso.GetExtensionName(FileItem.Name) ▲(さんかく) If LCase(Ext) = "abc" Then Set otherPageTS = fso.CreateTextFile(dataFolder.Path & "\" & Left(FileItem.Name, Len(FileItem.Name) - Len(Ext)-1) & ".html", True) otherPageTS.WriteLine "<HTML>" (中略) otherPageTS.WriteLine "</HTML>" otherPageTS.Close() 'トップページに各リンクを作成する。 Ext = fso.GetExtensionName(FileItem.Name) If LCase(Ext) = "html" Then indexPageTS.WriteLine "<a href=""" & rtFolder.Path & "\" & FileItem.Name & """>" & Left(FileItem.Name, Len(FileItem.Name) - Len(Ext)-1) & "</a><br>" End If End If End If Next End If Next 'トップページの続きを記述する。 indexPageTS.WriteLine "</BODY>" indexPageTS.WriteLine "</HTML>" indexPageTS.Close() 'データフォルダのサブフォルダへの処理。 For Each dataFolder In rtFolder.SubFolders If dataFolder <> "" Then Set currentFolder = fso.GetFolder(dataFolder.Path) If currentFolder <> "" Then Call SearchSubFolder1(currentFolder) End If End If Next 'オブジェクトの開放。 Set currentFolder = Nothing Set dataFolder = Nothing Set indexPageTS = Nothing Set otherPageTS = Nothing Set fso = Nothing End Sub

  • マクロの質問です。下記の式があるのですが、コピーしたい、セルには、文字

    マクロの質問です。下記の式があるのですが、コピーしたい、セルには、文字や計算式、又は他のセルから参照させてる物もあるので、張り付けたものに、エラーが数多く表示されるのですが、 コピー元の表示されてる文字を 張り付けることは、できるのでしょうか、 よろしくお願いします。 Sub 給与支払一覧() Application.ScreenUpdating = False Dim Sh As Worksheet For Each Sh In Worksheets If Sh.Name <> "給与支払一覧" And Sh.Name Like "Sheet*" Then With Worksheets("給与支払一覧") If Sh.Range("I14").Value > 0 Then With .Cells(.Rows.Count, 1).End(xlUp).Offset(1) Sh.Range("O2:X14").Copy .Cells(1) .Resize(6, 10).Value = Sh.Range("O2:X14").Value End With End If End With End If Next Sh Set Sh = Nothing End Sub

  • 連続データのVBAの質問

    お世話になります。 Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, k As Long, myNum As Long If Range("C1") <= Date - Day(Date) Then Exit Sub If Not Intersect(Target, Range("C1,B9:B39")) Is Nothing And Target.Count = 1 Then Application.EnableEvents = False With Target If .Column = 3 Then myNum = WorksheetFunction.Max(Range("B9:B39")) If IsDate(.Value) Then For i = 9 To 39 If Cells(i, "A").Value = "" Then Cells(i, "B").Value = "" Else Cells(i, "B") = myNum + i - 8 End If Next i End If Else i = .Row If .Value = "" Then Range(Cells(i + 1, "B"), Cells(39, "B")).ClearContents Else For k = i + 1 To 39 If Cells(k, "A").Value = "" Then Cells(k, "B").Value = "" Else Cells(k, "B") = Cells(k - 1, "B") + 1 End If Next k End If End If End With Application.EnableEvents = True ElseIf Not Intersect(Target, Range("R8:R38")) Is Nothing Then Application.EnableEvents = False Range(Cells(Target.Row, 18), Cells(39, 18)).Value = Target.Value Application.EnableEvents = True End If End Sub これはセルC1に年月を表記させ、そのC1セルの年月を変更した場合B9~B39のセルが自動で連続データの数字を記入し、B9~B39のどこかのセルを空白にすると、そのセル以降も空白になります。 そこで質問ですが、例えばB14の数字を消すとB15~39まで空白のセルになります。そして、B20に1と入力するとB21~39に連続データの数字が自動記入されます。 そしてC1の年月を次の月に更新した際は、B39で示された数字以降の連続データをB9に表示させるには、どうすれば良いでしょうか?

  • マクロで質問します。

    初心者です。 下記のようなマクロの式があるのですが、条件を一つ増やしたいのですが、 イロイロ試してみたのですが、うまくゆきませんので教えてください! Sub 給与支払一覧() Application.ScreenUpdating = False Dim Sh As Worksheet For Each Sh In Worksheets If Sh.Name <> "給与支払一覧" And Sh.Name Like "Sheet*" Then With Worksheets("給与支払一覧") If Sh.Range("D14").Value > 0 Then With .Cells(.Rows.Count, 1).End(xlUp).Offset(1) Sh.Range("O2:X14").Copy .Cells(1) .Resize(13, 10).Value = Sh.Range("O2:X14").Value End With End If End With End If Next Sh Set Sh = Nothing End Sub この中で If Sh.Range("D14").Value > 0 Then とありますが、 同じ条件で I14も 0より大きいな時としたいのですが、 うまくゆきませんでした。 たぶん基本できな簡単な事と思いますが 分かりません。 If Sh.Range("D14").Value > 0 Then If Sh.Range("I14").Value > 0 Then 並べてみたり If Sh.Range("D14、I14").Value > 0 Then こんなのや If Sh.Range("D14、I14").).Value > 0 Then このような事も 他にも笑われるようなことも・・・・・ よろしくお願いします。