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

Question

実現したいこと

交通費精算を素早くできるように、乗り換え検索より複数の乗り換え検索を自動で調べる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

Comments

[退会済みユーザー]

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

[m_yamamoto]

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

[sazi]

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

[m_yamamoto]

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

Answer 1

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

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

    出発(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

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