麻辣家族討論版版 - Powered by Discuz! Board

標題: 股票資料匯入，程式執行有問題 [打印本頁]

作者: caesar0125 時間: 2016-6-6 18:46 標題: 股票資料匯入，程式執行有問題

本帖最後由 GBKEE 於 2016-6-17 05:03 編輯

模仿版大編改一個程式

但匯入有時會停止中斷，停止的位置不一定

我懷疑是記憶體不足，該如何改呢？

Sub 歷史股價更新()
Dim xTable As Object, k As Integer, c As Integer, r As Integer, rc As Integer, sn As Integer
Dim url As String, i As Integer, E As Object
With Sheets("營運績效")
.UsedRange.Clear
End With
Sheets("總表").Select
rc = Cells(Rows.Count, 1).End(xlUp).Row
For i = 5 To rc
sn = Cells(i, 1)
url = "http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=" & sn & " &YEAR_PERIOD=10&RPT_CAT=M_YEAR"
With CreateObject("InternetExplorer.application")
.Visible = True
.Navigate url
Do While .Busy Or .readyState <> 4: DoEvents: Loop
Set xTable = .Document.getElementsByTagName("TABLE")(11) '資料在這
With Sheets("營運績效")
k = k + 1
For r = 0 To xTable.Rows.Length - 1
For c = 0 To xTable.Rows(r).Cells.Length - 1
.Cells(k, c + 1) = xTable.Rows(r).Cells(c).innertext
Next
k = k + 1
Next
End With
Set xTable = .Document.getElementsByTagName("TABLE")(13) '資料在這
With Sheets("營運績效")
k = k + 1
For r = 0 To xTable.Rows.Length - 1
For c = 0 To xTable.Rows(r).Cells.Length - 1
.Cells(k, c + 1) = xTable.Rows(r).Cells(c).innertext
Next
k = k + 1
Next
End With
Set xTable = .Document.getElementsByTagName("TABLE")(19) '資料在這
With Sheets("營運績效")
k = k + 1
For r = 0 To 3
For c = 0 To xTable.Rows(r).Cells.Length - 1
.Cells(k, c + 1) = xTable.Rows(r).Cells(c).innertext
Next
k = k + 1
Next
End With
.Quit
End With
Next
End Sub

複製代碼

作者: c_c_lai 時間: 2016-6-7 10:35

回復 1# caesar0125

『For i = 5 To rc』的 rc 如果超過十個以上，會發生以下之訊息：
所以建議不要一次無止盡的搜尋，最好分次、分時段的來執行。
「網站偵測到您的瀏覽量異常, 目前暫時關閉服務, 請稍後再重新查詢」

複製代碼

作者: c_c_lai 時間: 2016-6-7 10:55

回復 1# caesar0125
我將程式稍稍整理了一下，
加強 Focus 到 Sheets("營運績效")。

Sub 歷史股價更新()
Dim xTable As Object, k As Integer, c As Integer, r As Integer, rc As Integer, sn As Integer
Dim url As String, i As Integer, E As Object
Sheets("總表").Select
rc = Cells(Rows.Count, 1).End(xlUp).Row
k = 0
With Sheets("營運績效")
.Select
.UsedRange.Clear
End With
' For i = 5 To rc
For i = 1 To 5
sn = Sheets("總表").Cells(i, 1)
url = "http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=" & sn & " &YEAR_PERIOD=10&RPT_CAT=M_YEAR"
With CreateObject("InternetExplorer.application")
.Visible = True
.Navigate url
Do While .Busy Or .readyState <> 4: DoEvents: Loop
Set xTable = .Document.getElementsByTagName("TABLE")(11) ' 資料在這
With Sheets("營運績效")
k = k + 1
For r = 0 To xTable.Rows.Length - 1
For c = 0 To xTable.Rows(r).Cells.Length - 1
.Cells(k, c + 1) = xTable.Rows(r).Cells(c).innertext
Next
k = k + 1
Next
End With
Set xTable = .Document.getElementsByTagName("TABLE")(13) ' 資料在這
With Sheets("營運績效")
k = k + 1
For r = 0 To xTable.Rows.Length - 1
For c = 0 To xTable.Rows(r).Cells.Length - 1
.Cells(k, c + 1) = xTable.Rows(r).Cells(c).innertext
Next
k = k + 1
Next
End With
Set xTable = .Document.getElementsByTagName("TABLE")(19) ' 資料在這
With Sheets("營運績效")
k = k + 1
' For r = 0 To 3
For r = 0 To xTable.Rows.Length - 1
For c = 0 To xTable.Rows(r).Cells.Length - 1
.Cells(k, c + 1) = xTable.Rows(r).Cells(c).innertext
Next
k = k + 1
Next
End With
.Quit
End With
Next
End Sub

複製代碼

作者: c_c_lai 時間: 2016-6-7 10:59

回復 1# caesar0125
[attach]24438[/attach]

作者: caesar0125 時間: 2016-6-9 12:57

回復 4# c_c_lai
樓上大大

我的股票清單有50個，分批資料該如何處

我的程式是因為我的網路速度問題？有時捉到清單第3、4個，有時可捉到第20幾個

作者: GBKEE 時間: 2016-6-9 14:30

回復 5# caesar0125
我用IE8 抓取資料也有困難
改用 CreateObject("msxml2.xmlhttp") + CreateObject("htmlfile")
試看看

Sub goodinfo_合併財報()
Dim xTable As Object, k As Integer, C As Integer, R As Integer, rc As Integer, sn As Integer
Dim url As String, i As Integer, E As Variant
Dim oXmlhttp As Object, oHtmldoc As Object, surl, op
'Sheets("總表").Select
rc = Sheets("總表").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("營運績效").UsedRange.Clear
For i = 5 To rc
sn = Sheets("總表").Cells(i, 1)
url = "http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=" & sn & " &YEAR_PERIOD=10&RPT_CAT=M_YEAR"
Set oXmlhttp = CreateObject("msxml2.xmlhttp")
Set oHtmldoc = CreateObject("htmlfile")
With oXmlhttp
.Open "Get", url, False
.Send
oHtmldoc.write .responseText
End With
Set xTable = oHtmldoc.all.tags("TABLE")
With Sheets("營運績效")
' .Cells.Clear
For Each E In Array(11, 13, 19) '11,13,19 "TABLE"
k = k + 1
For R = 0 To xTable(E).Rows.Length - 1
For C = 0 To xTable(E).Rows(R).Cells.Length - 1
.Cells(k, C + 1) = xTable(E).Rows(R).Cells(C).innertext
Next
k = k + 1
Next
Next
End With
Next
End Sub

複製代碼

作者: c_c_lai 時間: 2016-6-10 07:23

本帖最後由 c_c_lai 於 2016-6-10 07:25 編輯

回復 5# caesar0125
你試試樓上 GBKEE 版大的模組，
其執行效率與速度非常的佳。畢竟
CreateObject("InternetExplorer.application")
之處裡的確耗時過久。

作者: c_c_lai 時間: 2016-6-10 09:45

回復 6# GBKEE
請教您，有好多回執行到

Set xTable = oHtmldoc.all.tags("TABLE")
With Sheets("營運績效")
' .Cells.Clear
For Each E In Array(11, 13, 19) '11,13,19 "TABLE"
k = k + 1
For R = 0 To xTable(E).Rows.Length - 1

複製代碼

中的 xTable(E).Rows.Length，便產生如下之錯誤訊息：

執行階段錯誤 '91'
沒有設定物件變數或 With 區域變數

複製代碼

查看 oXmlhttp.responseText : "<!DOCTYPE HTML>
<html lang="zh-TW">
<head>
  <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
  <meta http-equiv="X-UA-Compatible" content="I
又看不出有任何狀況，有時 xTable.length = 0 或  xTable.length =  1 等。

作者: GBKEE 時間: 2016-6-10 10:27

回復 8# c_c_lai
可加上防錯

Do
Set xTable = oHtmldoc.all.tags("TABLE")
Debug.Print xTable.Length, sn
' If xTable.Length >= 19 Then Stop
Loop Until xTable.Length >= 19

複製代碼

作者: c_c_lai 時間: 2016-6-10 16:13

回復 c_c_lai
可加上防錯
GBKEE 發表於 2016-6-10 10:27

如果 xTable.Length 為零，
Until xTable.Length >= 19 會如同死胡同
永遠出不來，所以我改成
If xTable.Length >= 19 Then
.
.
End If
仍然是一推

1 0 1437
2 0 1438
3 0 1439
4 0 1440
5 0 1441

複製代碼

作者: GBKEE 時間: 2016-6-10 19:23

回復 10# c_c_lai
XP IE8 用 6#的程式碼,沒加上防錯的程式碼
沒有你所說的錯誤

http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=1437 &YEAR_PERIOD=10&RPT_CAT=M_YEAR
24 1437
http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=1438 &YEAR_PERIOD=10&RPT_CAT=M_YEAR
24 1438
http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=1439 &YEAR_PERIOD=10&RPT_CAT=M_YEAR
24 1439
http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=1440 &YEAR_PERIOD=10&RPT_CAT=M_YEAR
24 1440
http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=1441 &YEAR_PERIOD=10&RPT_CAT=M_YEAR
24 1441
http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=1442 &YEAR_PERIOD=10&RPT_CAT=M_YEAR
24 1442
http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=1443 &YEAR_PERIOD=10&RPT_CAT=M_YEAR
24 1443
http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=1444 &YEAR_PERIOD=10&RPT_CAT=M_YEAR
24 1444

複製代碼

作者: c_c_lai 時間: 2016-6-10 20:09

回復 11# GBKEE
明天我再來仔細測試一下。
不信邪，結果依然有錯誤信息：
[attach]24459[/attach]

作者: c_c_lai 時間: 2016-6-10 20:15

回復 11# GBKEE
附上檔案堤供測試：
[attach]24460[/attach]

作者: GBKEE 時間: 2016-6-11 07:05

回復 13# c_c_lai
這網頁有流量管制.

作者: c_c_lai 時間: 2016-6-11 07:50

回復 c_c_lai
這網頁有流量管制.
GBKEE 發表於 2016-6-11 07:05

沒錯，它還會丟出訊息：

網站偵測到您的瀏覽量異常, 目前暫時關閉服務, 請稍後再重新查詢

複製代碼

謝謝您囉！

作者: c_c_lai 時間: 2016-6-11 07:54

回復 14# GBKEE
額外再請教您，在附上之『融資融券與上市當沖.xls』
選紐『融資融券 III』對應的「Sub 融資融券3()」，
url 裡為何我一直抓不到正確的 selectType 對應值？
在「Sub 融資融券2()」使用 .QueryTables.Add() 的方式
即可正確取得？
謝謝您！
[attach]24462[/attach]
[attach]24463[/attach]

作者: GBKEE 時間: 2016-6-12 07:51

本帖最後由 GBKEE 於 2016-6-12 15:02 編輯

回復 16# c_c_lai

url 裡為何我一直抓不到正確的 selectType 對應值？
網頁的建置我沒入門,所以我也在摸索中

  .getElementsByName:    getElements 複數-> 物件的集合
  .getElementsBytagName:  getElements 複數-> 物件的集合
  .ALL.tags:                   tags 複數-> 物件的集合
  .getElementById :       getElement  單數 ->單一的物件

Set xTable = oHtmldoc.ALL.tags("TABLE")
Stop
'看看區域變數視窗 xTable 的內容
Set xTable = oHtmldoc.ALL.tags("TABLE")(0)
Stop
'再次看看區域變數視窗 xTable 的內容
MsgBox xTable.INNERTEXT

複製代碼

附檔中有許多相同的程式碼.,,,,,,,,,,,

TVal = Array("MS", "", "0049", "0099P", "019919T", "0999", "0999P", "01", "02", "03", _
"04", "05", "06", "07", "21", "22", "08", "09", "10", _
"11", "12", "13", "24", "25", "26", "27", "28", "29", _
"30", "31", "14", "15", "16", "17", "18", "23", "9299", "19", "20", "CB")
'**************************
If .ComboBox1.Value = "Select Name" Then
MsgBox ("您尚未選擇「產業類別」，請於" & vbCrLf & "確認後再次點選『開啟網頁』，" & vbCrLf & "謝謝您！")
Exit Sub
End If
For cts = 0 To UBound(lst)
If lst(cts) = .[D1] Then select2 = TVal(cts): Exit For
Next cts

複製代碼

可以整合一下

Option Explicit
Const MyUrl = "http://www.twse.com.tw/ch/trading/exchange/MI_MARGN/MI_MARGN.php"
Private Sub Workbook_Open()
Dim oHtmldoc, op, cts
Set oHtmldoc = CreateObject("htmlfile")
With CreateObject("msxml2.xmlhttp")
.Open "Get", MyUrl, False
.Send
Do While .Status <> 200 Or .readyState <> 4: DoEvents: Loop
oHtmldoc.write .responseText
End With
Set op = oHtmldoc.all.tags("select")("selectType")
With Sheets("總表").ComboBox1
.Clear
For cts = 0 To op.Length - 1
.AddItem '清單方塊或下拉式清單方塊中加入一個項目
.List(.ListCount - 1, 0) = op(cts).Text ' 第1欄,最多9欄
.List(.ListCount - 1, 1) = op(cts).Value ' 第2欄,最多9欄
Next
.Value = "Select Name" '.List(0) '0: 信用交易統計, 1:全部,2: 封閉式基金......
End With
End Sub

複製代碼

Private Function Select_Name() As Integer
With Sheets("總表").ComboBox1
If .ListIndex = -1 Then MsgBox ("您尚未選擇「產業類別」，請於" & vbCrLf & "確認後再次點選『開啟網頁』，" & vbCrLf & "謝謝您！")
Select_Name = .ListIndex
End With
End Function

複製代碼

Sub 融資融券2()
Dim qdate As String, select2 As String
'Dim TVal(), cts As Integer
If Select_Name = -1 Then
Exit Sub
Else
With Sheets("總表")
qdate = Format(.[B1], "EE/MM/DD")
With .ComboBox1
select2 = .List(.ListIndex, 1)
End With
End With
End If
With Sheets("融資_融券")
.Select
.Cells.Clear
End With

複製代碼

作者: c_c_lai 時間: 2016-6-13 08:16

回復 17# GBKEE
好建議收到了，抽時間再來試試整合後之效果，
原本裡面的主題模組是各自獨立的應用測試，
突發奇想，如果同一主題均分別使用不同處理方式，
如 CreateObject("InternetExplorer.Application")、
.QueryTables.Add()、以及 CreateObject("msxml2.xmlhttp")
與 CreateObject("htmlfile") 搭配應用等，並觀察它們同時外部
帶入參數、如 url = "http://www.twse.com.tw/ch/trading/exchange/MI_MARGN/MI_MARGN.php?qdate=" & xDate & "&selectType=" & select2
或內部處理方式，如 .Document.ALL("input_date").Value = xDate
.Document.ALL("select2").SelectedIndex = i 以及內部觸發之
.Document.ALL("login_btn").Click 等的不同應用，從其各別的角度
來評估執行成效的。並藉此亦可啟發大家的知的權益及多方之應用。
謝謝您囉！

作者: c_c_lai 時間: 2016-6-13 11:02

回復 17# GBKEE
測試用 (已套用您建議之函數)

Sub Test()
Dim xTable As Object, k As Integer, C As Integer, R As Integer ' , sn As Integer
Dim url As String, cts As Integer, E As Variant, xDate As String ' , rc As Integer
Dim oXmlhttp As Object, oHtmldoc As Object, select2 As String ' , tm
Dim TVal() As Variant
If Select_Name = -1 Then Exit Sub
TVal = Array("MS", "ALL", "0049", "0099P", "019919T", "0999", "0999P", "01", "02", "03", _
"04", "05", "06", "07", "21", "22", "08", "09", "10", _
"11", "12", "13", "24", "25", "26", "27", "28", "29", _
"30", "31", "14", "15", "16", "17", "18", "23", "9299", "19", "20", "CB")
xDate = Format(Sheets("總表").[B1], "EE/MM/DD")
url = "http://www.twse.com.tw/ch/trading/exchange/MI_MARGN/MI_MARGN.php?qdate=" & xDate & "&selectType=" & TVal(Select_Name)
'url = "http://www.twse.com.tw/ch/trading/exchange/MI_MARGN/MI_MARGN.php?qdate=" & xDate & "&selectType=" & Select_Name
'url = "http://www.twse.com.tw/ch/trading/exchange/MI_MARGN/MI_MARGN.php?qdate=" & xDate & "&selectType=水泥工業"
Set oXmlhttp = CreateObject("msxml2.xmlhttp")
Set oHtmldoc = CreateObject("htmlfile")
With oXmlhttp
.Open "Get", url, False
.Send
Do While .Status <> 200 Or .readyState <> 4: DoEvents: Loop
oHtmldoc.write .responseText
'MsgBox .responseText
End With
Set xTable = oHtmldoc.ALL.tags("TABLE")
' Stop
' 看看區域變數視窗 xTable 的內容
Set xTable = oHtmldoc.ALL.tags("TABLE")(0)
' Stop
' 再次看看區域變數視窗 xTable 的內容
MsgBox xTable.INNERTEXT
End Sub
Private Function Select_Name() As Integer
With Sheets("總表").ComboBox1
If .ListIndex = -1 Then MsgBox ("您尚未選擇「產業類別」，請於" & vbCrLf & "確認後再次點選『開啟網頁』，" & vbCrLf & "謝謝您！")
Select_Name = .ListIndex ' Select_Name = -1,0,1,2,3,4,5,6,7,8,9,.....39
End With
End Function

複製代碼

[attach]24470[/attach]

作者: c_c_lai 時間: 2016-6-13 11:03

回復 17# GBKEE
[attach]24471[/attach]

作者: stillfish00 時間: 2016-6-13 16:16

回復 20# c_c_lai
看上圖106行 form method="post"
說明當你點查詢時是以post傳送請求，所以你不能只用get在網址加參數。

作者: c_c_lai 時間: 2016-6-13 18:54

回復 21# stillfish00
請教應如何解決呢？
困軟我多日了。
謝謝妳！

作者: stillfish00 時間: 2016-6-14 09:39

回復 20# c_c_lai
可以稍微參考這帖 : http://forum.twbts.com/viewthread.php?tid=15544

Sub Test()
Dim xTable As Object, k As Integer, C As Integer, R As Integer ' , sn As Integer
Dim url As String, cts As Integer, E As Variant, xDate As String ' , rc As Integer
Dim oXmlhttp As Object, oHtmldoc As Object, select2 As String ' , tm
Dim TVal() As Variant
If Select_Name = -1 Then Exit Sub
TVal = Array("MS", "ALL", "0049", "0099P", "019919T", "0999", "0999P", "01", "02", "03", _
"04", "05", "06", "07", "21", "22", "08", "09", "10", _
"11", "12", "13", "24", "25", "26", "27", "28", "29", _
"30", "31", "14", "15", "16", "17", "18", "23", "9299", "19", "20", "CB")
url = "http://www.twse.com.tw/ch/trading/exchange/MI_MARGN/MI_MARGN.php"
xDate = Format(Sheets("總表").[B1], "EE/MM/DD")
sPost = "qdate=" & Replace(xDate, "/", "%2F") & "&selectType=" & TVal(Select_Name) 'urlencode
Set oXmlhttp = CreateObject("msxml2.xmlhttp")
Set oHtmldoc = CreateObject("htmlfile")
With oXmlhttp
.Open "Post", url, False
'.setRequestHeader "Connection", "Keep-Alive" '短時間內多次查詢建議可加這行
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Content-Length", Len(sPost)
.Send sPost
'上面 Open 參數用False(=同步)，可以不用再判斷status
'Do While .Status <> 200 Or .readyState <> 4: DoEvents: Loop
oHtmldoc.write .responseText
'MsgBox .responseText
End With
Set xTable = oHtmldoc.ALL.tags("TABLE")
' Stop
' 看看區域變數視窗 xTable 的內容
Set xTable = oHtmldoc.ALL.tags("TABLE")(0)
' Stop
' 再次看看區域變數視窗 xTable 的內容
MsgBox xTable.INNERTEXT
End Sub

複製代碼

作者: c_c_lai 時間: 2016-6-14 11:11

回復 23# stillfish00
非常謝謝你！
之前碰到的練習都是接觸到 Get，
所以也沒留意如何去應用 Post 的處哩，
感謝你的指導。目前
TVal = Array("MS", "ALL", "0049", "0099P", "019919T", "0999", "0999P", "01", "02", "03", _
            "04", "05", "06", "07", "21", "22", "08", "09", "10", _
            "11", "12", "13", "24", "25", "26", "27", "28", "29", _
            "30", "31", "14", "15", "16", "17", "18", "23", "9299", "19", "20", "CB")
目前就只剩下 "ALL" (全部) 的問題仍抓不到，其餘都 OK，或許代碼不對抑或是 . . . . .
[attach]24489[/attach]
我再繼續加油吧。
再次謝謝你囉！

作者: GBKEE 時間: 2016-6-15 14:25

本帖最後由 GBKEE 於 2016-6-15 14:33 編輯

回復 15# c_c_lai
應運網頁有流量管制.
1 檔案關閉
2重開檔案, 重啟adsl的連線,執行程式

另設一個要開開關關 goodinfo_合併財報檔案的檔案
ThisWorkbook 模組的程式碼

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.Quit
End Sub
Private Sub Workbook_Open()
Dim App As New Application, xFile As String
xFile = "D:\goodinfo_合併財報.xls" ' goodinfo_合併財報程式的檔案
Application.Visible = False
Re_App:
With App
.Visible = True
.Workbooks.Open (xFile)
End With
If App.Visible = False Then
Set App = Nothing
GoTo Re_App
End If
ThisWorkbook.Close
End Sub

複製代碼

goodinfo_合併財報檔案 ThisWorkbook 模組的程式碼

Option Explicit
Private Sub Workbook_Open()
adsl連線 '參考 http://forum.twbts.com/thread-17716-1-1.html 的 adsl連線程式碼
goodinfo_合併財報
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.Quit
End Sub
Sub goodinfo_合併財報()
Dim xTable As Object, k As Integer, C As Integer, sn As Double, r As Integer
Dim url As String, i As Double, E As Variant
Dim oXmlhttp As Object, oHtmldoc As Object, surl, op, tm
For Each E In ThisWorkbook.Names
If E.Name = "報表開始列" Then GoTo xStart
Next
ThisWorkbook.Names.Add "報表開始列", 1
ThisWorkbook.Names.Add "報表開時間", Time
ThisWorkbook.Activate
xStart:
Sheets("營運績效").Activate
With Sheets("營運績效2")
.UsedRange.Clear
End With
For i = [報表開始列] To Sheets("總表").Cells(Rows.Count, 2).End(xlUp).Row '
APP_EX:
sn = Sheets("總表").Cells(i, 2)
url = "http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=" & sn & "&YEAR_PERIOD=10&RPT_CAT=M_YEAR"
Set oXmlhttp = CreateObject("msxml2.xmlhttp")
Set oHtmldoc = CreateObject("htmlfile")
With oXmlhttp
.Open "Get", url, False
.Send
oHtmldoc.write .responseText
End With
Set xTable = oHtmldoc.all.tags("TABLE")
'*********可觀看流量被管制 ************************************
Sheets("營運績效").Cells(i, 1).Resize(, 3) = Array(xTable.Length, sn, Time)
Sheets("營運績效").Cells(i, 1).Select
'************************************************************
If xTable.Length = 0 Then
ThisWorkbook.Names.Add "報表開始列", i
ThisWorkbook.Close True
End If
With Sheets("營運績效2")
For Each E In Array(11, 13, 19) '11,13,19 "TABLE"
k = k + 1
For r = 0 To xTable(E).Rows.Length - 1
For C = 0 To xTable(E).Rows(r).Cells.Length - 1
.Cells(k, C + 1) = xTable(E).Rows(r).Cells(C).innertext
Next
k = k + 1
Next
Next
End With
Next
ThisWorkbook.Names("報表開始列").Delete
MsgBox "費時 " & Application.Text(Time - [報表開時間], "M分S秒") & " Finished Complete!"
End Sub

複製代碼

作者: c_c_lai 時間: 2016-6-15 15:42

回復 25# GBKEE
謝謝您！
#15 ~ #20 間的提問，最後我是以

.Open "Post", url, False

複製代碼

取代了

.Open "Get", url, False

複製代碼

才得以解決 "&select2=" & TVal(Select_Name)
的參數引入問題。
可是卻出現寫入之文字部分是一堆亂碼，
所以才會再丟出由網頁取得的資料，不知道要如何同步編碼成正確之中文碼回傳
相關的提問。上網查看了 Google/亂碼的討論
好似不太搭嘎，難以解題。
謝謝您費心地回復。
上述 "如何同步編碼" 我亦有加入補充，並附上檔案
再次謝謝您了！麻煩您！

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)