質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
スクレイピング

スクレイピングとは、公開されているWebサイトからページ内の情報を抽出する技術です。

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Internet Explorer

Internet Explorer(IE;MSIE)はマイクロソフトが開発したウェブブラウザです。Microsoft Windowsに組み込まれています。

検索

検索は、あるデータの集まりの中から 目的のデータを見つけ出すことです。

Q&A

1回答

1301閲覧

複数経路の時間を一括で調べるExcelVBA

m_yamamoto

総合スコア5

スクレイピング

スクレイピングとは、公開されているWebサイトからページ内の情報を抽出する技術です。

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Internet Explorer

Internet Explorer(IE;MSIE)はマイクロソフトが開発したウェブブラウザです。Microsoft Windowsに組み込まれています。

検索

検索は、あるデータの集まりの中から 目的のデータを見つけ出すことです。

0グッド

0クリップ

投稿2021/06/21 08:26

実現したいこと

交通費精算を素早くできるように、乗り換え検索より複数の乗り換え検索を自動で調べるVBAコードを作成してもらったのですが、最後までいくとエラーメッセージがでます。
セルが空白になった段階で処理を終了できるように修正をしたいです。
お分かりになられる方ご教授ください。
全く知識のない初心者でございますので、コードを修正して頂けると大変助かります。

発生している問題・エラーメッセージ

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

該当のソースコード

Option Explicit Dim IE As Object Dim txtInput(16) As Object 'Declare Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long) Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Sub 時間確認() Dim 出発() As String Dim 到着() As String Dim 検索タイプ() As String Dim 日付() As Date Dim 時間() As Date Dim 飛行機() As String Dim 新幹線() As String Dim 有料特急() As String Dim 高速バス() As String Dim 路線バス() As String Dim フェリー() As String Dim 検索結果の表示順() As String Dim URL() As String Dim i As Long i = 0 For i = 0 To Cells(Rows.Count, 3).End(xlUp).Row ReDim Preserve 出発(i) As String ReDim Preserve 到着(i) As String ReDim Preserve 検索タイプ(i) As String ReDim Preserve 日付(i) As Date ReDim Preserve 時間(i) As Date ReDim Preserve 飛行機(i) As String ReDim Preserve 新幹線(i) As String ReDim Preserve 有料特急(i) As String ReDim Preserve 高速バス(i) As String ReDim Preserve 路線バス(i) As String ReDim Preserve フェリー(i) As String ReDim Preserve 検索結果の表示順(i) As String ReDim Preserve URL(i) As String 出発(i) = Cells(i + 4, 3) 到着(i) = Cells(i + 4, 4) Select Case Cells(i + 4, 5) Case Is = "出発" 検索タイプ(i) = "1" Case Is = "到着" 検索タイプ(i) = "4" Case Is = "始発" 検索タイプ(i) = "3" Case Is = "終電" 検索タイプ(i) = "2" Case Is = "指定なし" 検索タイプ(i) = "5" Case Else 検索タイプ(i) = "5" End Select If Cells(i + 4, 6) <> "" Then 日付(i) = Cells(i + 4, 6) Else 日付(i) = Date End If If Cells(i + 4, 7) <> "" Then 時間(i) = Cells(i + 4, 7) Else 時間(i) = "9:00" End If If Cells(i + 4, 8) <> "" Then 飛行機(i) = "1" Else 飛行機(i) = "0" End If If Cells(i + 4, 9) <> "" Then 新幹線(i) = "1" Else 新幹線(i) = "0" End If If Cells(i + 4, 10) <> "" Then 有料特急(i) = "1" Else 有料特急(i) = "0" End If If Cells(i + 4, 11) <> "" Then 高速バス(i) = "1" Else 高速バス(i) = "0" End If If Cells(i + 4, 12) <> "" Then 路線バス(i) = "1" Else 路線バス(i) = "0" End If If Cells(i + 4, 13) <> "" Then フェリー(i) = "1" Else フェリー(i) = "0" End If Select Case Cells(i + 4, 14) Case Is = "到着が早い順" 検索結果の表示順(i) = "0" Case Is = "料金が安い順" 検索結果の表示順(i) = "1" Case Is = "乗り換え回数順" 検索結果の表示順(i) = "2" Case Else End Select URL(i) = "https://transit.yahoo.co.jp/search/result?flatlon=&" & _ "from=" & Application.WorksheetFunction.EncodeURL(出発(i)) & _ "&tlatlon=" & _ "&to=" & Application.WorksheetFunction.EncodeURL(到着(i)) & _ "&via=&via=&via=" & _ "&y=" & Format(Year(日付(i)), "0000") & _ "&m=" & Format(Month(日付(i)), "00") & _ "&d=" & Format(Day(日付(i)), "00") & _ "&hh=" & Format(Hour(時間(i)), "00") & _ "&m2=" & Right(Format(Minute(時間(i)), "00"), 1) & _ "&m1=" & Left(Format(Minute(時間(i)), "00"), 1) & _ "&type=" & 検索タイプ(i) & _ "&ticket=" & "ic" & _ "&al=" & 飛行機(i) & _ "&shin=" & 新幹線(i) & _ "&ex=" & 有料特急(i) & _ "&hb=" & 高速バス(i) & _ "&lb=" & 路線バス(i) & _ "&sr=" & フェリー(i) & _ "&s=" & 検索結果の表示順(i) & _ "&expkind=" & "1" & "&ws=" & "3" '自由席優先で歩くの少しゆっくり 'IE立上げ Set IE = CreateObject("InternetExplorer.application") IE.Visible = True IE.navigate (URL(i)) Do While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE DoEvents Sleep 1 Loop Sleep 500 '乗り換え案内結果集計 Set txtInput(0) = IE.document.getElementsByClassName("time")(0) Cells(i + 4, 15).Value = txtInput(0).innerText Set txtInput(1) = IE.document.getElementsByClassName("time")(1) Cells(i + 4, 16).Value = txtInput(1).innerText Set txtInput(2) = IE.document.getElementsByClassName("fare")(0) Cells(i + 4, 17).Value = txtInput(2).innerText Set txtInput(3) = IE.document.getElementsByClassName("time")(2) Cells(i + 4, 18).Value = txtInput(3).innerText Set txtInput(4) = IE.document.getElementsByClassName("fare")(1) Cells(i + 4, 19).Value = txtInput(4).innerText Set txtInput(5) = IE.document.getElementsByClassName("time")(3) Cells(i + 4, 20).Value = txtInput(5).innerText Set txtInput(6) = IE.document.getElementsByClassName("fare")(2) Cells(i + 4, 21).Value = txtInput(6).innerText 'IE終了 IE.Quit Next i End Sub

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

退会済みユーザー

退会済みユーザー

2021/06/21 09:58

本件、回答依頼をいただきましたが、私の手元環境では動作させることができず、コードを読むだけでは原因がわかりませんでした。まことに申し訳ございませんが、他の方をあたっていただけますようお願いいたします。
m_yamamoto

2021/06/21 10:10

ご返信ありがとうございます。 かしこまりました。 ご確認ありがとうございます。
sazi

2021/06/21 13:18 編集

> VBAコードを作成してもらったのですが 作者に問い合わせるのが一番早いのでは? 事情が無ければ、単に丸投げの質問という評価が付いているので、回答が付き辛いと思われます。
m_yamamoto

2021/06/21 14:23

ご返信ありがとうございます。 以前はSESの方がいたのですが、現在はもういなくてですね。。 こういう質問はよくないのですかね? 私がこのサイトの使い方の認識が間違っていたのかもしれません。 申し訳ございません。
guest

回答1

0

セルが空白になった段階で処理を終了できるように修正をしたいです。

のところですが、
(動かせていないので見当違いかもしれませんが)

出発(i) = Cells(i + 4, 3) 到着(i) = Cells(i + 4, 4)

から察するに、実データは4行目から入力するようになっていると推測されます。
したがって、最初の方にある

For i = 0 To Cells(Rows.Count, 3).End(xlUp).Row

For i = 0 To Cells(Rows.Count, 3).End(xlUp).Row - 4

というようにすると、空白行を読み取って実行することはなくなるのではないでしょうか。

投稿2021/06/22 14:35

退会済みユーザー

退会済みユーザー

総合スコア0

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

まだベストアンサーが選ばれていません

会員登録して回答してみよう

アカウントをお持ちの方は

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問