Sub Sample1()
 Dim objIE As Object
 Dim strURL As String
 Dim WS1 As Worksheet
 Dim WS2 As Worksheet
 Dim v As Variant
 Dim lngRow As Long, lngPage As Long
 Dim vv(1 To 20, 1 To 3) As Variant
 Dim x As Long
 
 Set WS1 = Worksheets("結果")
 Set WS2 = Worksheets("作業")
 
 
 WS1.Cells.Delete
 WS2.Cells.Delete
 
 Set objIE = CreateObject("InternetExplorer.Application")
 
' Do
 lngPage = lngPage + 1
 
 strURL = "http://www.jalan.net/us/usp3000/usw3001.do?screenId=USW3001&Count=10&stayDay=01&nextPageCount=10&stayCount=1&yadNo=377189&maxPrice=999999&rootCd=7705&stayMonth=03&dispCount=10&srcScreenId=USW3001&roomCount=1&stayYear=2014&adultNum=2&pageLimit=10&minPrice=0&reShFlg=1&pagingFlg=0&idx=0&activeSort=1&tabFlg=1"
 If lngPage > 1 Then
 strURL = strURL & "page=" & lngPage
 End If
 Application.StatusBar = lngPage & " ﾍﾟｰｼﾞを取得中"
 
 With objIE
 .Navigate strURL
 Do While .Busy
 DoEvents
 Loop
 Do While .ReadyState <> 4
 DoEvents
 Loop
 .ExecWB 17, 2, 0, 0
 .ExecWB 12, 2, 0, 0
 End With
 
 With WS2
 .Paste .Range("A1")
 .Hyperlinks.Delete
 .DrawingObjects.Delete
 .UsedRange.EntireColumn.AutoFit
 With Application
 .CutCopyMode = False
 .ScreenUpdating = True
 End With
 With .Cells
 .WrapText = False
 .Orientation = 0 'ｾﾙ結合解除
 .AddIndent = False
 .ShrinkToFit = False
 .ReadingOrder = xlContext
 .MergeCells = False
 End With
 End With
 v = WS2.UsedRange.Value
 x = 0
 
 WS1.Cells(1, 1) = "ﾌﾟﾗﾝ名"
 WS1.Cells(1, 2) = "金額"
 
 For lngRow = 1 To UBound(v)
 If v(lngRow, 1) = "安い順" Then
 WS1.Cells(2, 1) = v(lngRow + 2, 1)
 WS1.Cells(2, 2) = v(lngRow + 4, 1)

 Exit For
 End If

 Next
 
' Loop
 Application.StatusBar = False
 
 objIE.Quit
 Set objIE = Nothing
 
 MsgBox "取得しました"
End Sub

参考先のVBAを 変更してみました｡

土日､祝日3ヶ月分の最安値というのは わかりませんが
一番上のﾌﾟﾗﾝと金額とあるので 一番上のものを もってくるようにしてみました｡

ｼｰﾄのA列に施設､1行目に集したい日付を列挙して収集する例です｡

こちらはおまけ｡
最初に Set3MonthHolidays 実行してください｡

上に続けて GetTopPlan を実行してください｡

Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub GetTopPlan()
 Dim objIE As Object
 Set objIE = CreateObject("InternetExplorer.Application")
 
 Dim strURL As String
 Dim r, c
 For r = 2 To Cells(Rows.Count, "A").End(xlUp).Row
 For c = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
 strURL = "http://www.jalan.net/us/usp3000/usw3001.do?screenId=USW3001&Count=10" _
 & "&stayDay=" & Format(Cells(1, c).Value, "DD") _
 & "&nextPageCount=10&stayCount=1&yadNo=" & Cells(r, "A").Value _
 & "&maxPrice=999999&rootCd=7705" _
 & "&stayMonth=" & Format(Cells(1, c).Value, "MM") _
 & "&dispCount=10&srcScreenId=USW3001&roomCount=1&stayYear=2014&adultNum=2&pageLimit=10&minPrice=0&reShFlg=1&pagingFlg=0&idx=0&activeSort=1&tabFlg=1"
 
 With objIE
 .Navigate strURL
' .Visible = True
 Do While .Busy Or .ReadyState <> 4
 DoEvents
 Loop
 End With
 
 Dim plan, txt
 Set plan = objIE.document.getElementByID("planListElem").GetElementsByTagName("li")
 If plan.Length > 0 Then
 For Each txt In Split(plan(0).innerText, vbNewLine)
 If InStr(txt, "合計") > 0 Then
 Cells(r, c).Value = Trim(Replace(Split(txt, "円")(0), "合計", ""))
 Exit For
 End If
 Next
 Else
 Cells(r, c).Value = ""
 End If
 Sleep (300)
 Next
 Next
 objIE.Quit
End Sub

Sub Set3MonthHolidays()
 Dim dt
 dt = Array("2/22", "2/23", "3/1", "3/2", "3/8", "3/9", "3/15", "3/16", "3/21", "3/22", "3/23", "3/29", "3/30", "4/5", "4/6", "4/12", "4/13", "4/19", "4/20", "4/26", "4/27", "4/29", "5/2", "5/3", "5/4", "5/5", "5/6", "5/10", "5/11", "5/17", "5/18")
 Range("B1").Resize(1, UBound(dt) + 1) = dt
 dt = Array("377189", "313270", "324255")
 Range("A2").Resize(UBound(dt) + 1, 1) = Application.Transpose(dt)
End Sub

Mookさん
上記のｺｰﾄﾞを次のように修正は可能でしょうか？

･日付､取り込んだﾃﾞｰﾀは横に集計｡
･取り込みたいﾃﾞｰﾀは合計の金額だけを取り込みたい｡ 61,000というように｡
･ﾎﾃﾙ番号をsheet2に記入しておいて複数のﾎﾃﾙの最安値を取り込みたい｡
ﾎﾃﾙ番号
377189
313270
324255
･
･
･

お手数をお掛けしますが､よろしくお願い致します｡