標題:
[發問]
Web更新網頁,會跑出 2組出來 (黃色)
[打印本頁]
作者:
7777
時間:
2018-9-4 12:41
標題:
Web更新網頁,會跑出 2組出來 (黃色)
請教
Web更新網頁,會跑出 2組出來 (黃色)
1.該 如何解決處理~
2.可以 如何簡化...
感謝
VB 慢慢..學習中
[attach]29335[/attach]
[attach]29334[/attach]
作者:
a5007185
時間:
2018-9-4 14:42
回復
1#
7777
初步判定,
就算手動全選複製一樣會出現同樣的問題,
建議採用關鍵字複製原始文本,
(可參考一些爬蟲文章)
暫時先幫到這,
等有空我再來研究研究 XD
作者:
iamaraymond
時間:
2018-9-5 12:22
回復
1#
7777
Sub Future()
Dim myXML As Object
Set myXML = CreateObject("Microsoft.XMLHTTP")
Dim myHTML As Object
Set myHTML = CreateObject("HTMLFile")
ReDim myArr(1 To 55, 1 To 15)
With myXML
.Open "GET", "http://info512.taifex.com.tw/Future/FusaQuote_Norl.aspx?t=" & Timer, False
.send
myHTML.body.innerHTML = .responseText
Set myTable = myHTML.getElementByID("ctl00_ContentPlaceHolder1_uc_DgFusaQuote1_dgData")
i = 1
For Each myRow In myTable.Rows
j = 1
For Each myCell In myRow.Cells
myArr(i, j) = myCell.innerText
j = j + 1
Next
i = i + 1
Next
End With
Range("A5").Resize(55, 15).Value = myArr
Set myXML = Nothing
Erase myArr
End Sub
Sub Opt()
Dim myXML As Object
Set myXML = CreateObject("Microsoft.XMLHTTP")
Dim myHTML As Object
Set myHTML = CreateObject("HTMLFile")
ReDim myArr(1 To 30, 1 To 13)
With myXML
.Open "GET", "http://info512.taifex.com.tw/Future/OptQuote_Norl.aspx?t=" & Timer, False
.send
myHTML.body.innerHTML = .responseText
Set myTable = myHTML.getElementByID("ctl00_ContentPlaceHolder1_uc_DgOptQuote1_UpdatePanel1").getElementsByTagName("table")(0)
i = 1
For Each myRow In myTable.Rows
j = 1
For Each myCell In myRow.Cells
myArr(i, j) = myCell.innerText
j = j + 1
Next
i = i + 1
Next
End With
Range("R5").Resize(30, 13).Value = myArr
Set myXML = Nothing
Erase myArr
End Sub
複製代碼
作者:
GBKEE
時間:
2018-9-5 15:22
本帖最後由 GBKEE 於 2018-9-5 15:23 編輯
回復
1#
7777
Option Explicit
Sub EX_網頁()
Dim oXmlhttp As Object, oHtmldoc As Object, E As Object, R As Integer, C As Integer
Dim I As Integer, AR(1 To 2)
AR(1) = "http://info512.taifex.com.tw/Future/FusaQuote_Norl.aspx"
AR(2) = "http://info512.taifex.com.tw/Future/OptQuote_Norl.aspx"
Cells.Clear
For I = 1 To 2
Set oXmlhttp = CreateObject("msxml2.xmlhttp")
Set oHtmldoc = CreateObject("htmlfile")
With oXmlhttp
.Open "Get", AR(I), False
.send
oHtmldoc.write .responseText
End With
Set E = oHtmldoc.all.tags("TABLE")( 12))
For R = 0 To E.Rows.Length - 1
For C = 0 To E.Rows(R).Cells.Length - 1
With IIf(I = 1, [A26], [T26])
.Cells(R + 1, C + 1) = E.Rows(R).Cells(C).innerText
End With
Next
Next
Set oXmlhttp = Nothing
Set oHtmldoc = Nothing
Next
End Sub
複製代碼
作者:
a5007185
時間:
2018-9-5 15:36
回復
4#
GBKEE
謝謝超級板主的分享!
因為有你們熱心的分享,
才能讓我們這些後輩可以開眼界~ : )
作者:
7777
時間:
2018-9-6 16:02
回復
3#
iamaraymond
感謝
Raymond Chien 的大力幫忙
程式OK
本人再研究學習中,
超級感謝~~熱心的幫忙。
作者:
7777
時間:
2018-9-6 16:03
回復
4#
GBKEE
謝謝 GBKEE 的分享!
程式OK
Set E = oHtmldoc.all.tags("TABLE")( 12)
)
多了 一個
")"
感謝
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)