泰語翻譯

Erase TempArray()

改成

感激分享
For Each delsheet In Worksheets
可以給我網站嗎，我想嘗嘗如果用 msxml2.xmlhttp 不跑多工 翻譯話，能不能行的通

(2016/3/27 更新，試寫一個用 script 體例抓資料 翻譯程式碼)
(5/23 71樓，增添WinHttp post方式，可取得選擇資料種類後，網址不變沒法用get體例獲得資料的網頁)


p.s 此版本會在windwos\temp 產生大量暫存檔
ReDim Stockname(lastrow - 2) 翻譯公司 TempArray(lastrow - 2)
(7/7 223樓，增添證券櫃檯生意中間，上櫃統計報表個股年成交資訊html + csv下載典範榜樣)
(5/4文未增添中文亂碼解決體例，順便多加幾個doevents，21樓有簡略單純版程式碼)

Yahoo 台灣股市 每天約有 15600 筆股票權證 收盤資料，悉數如許抓 沒有多久就會被 ban 了，而且如許也太花時間了 翻譯社

Wei_1144 wrote:


If i = j Then
Next j
Dim URL, HTMLsourcecode, GetXml
doevents
Else
1、闡發真實查詢位置
二、webquest iqy
3、csv table
4、ie object
5、microsoft.XMLHTTP
6、msxml2.xmlhttp
7、access sql
8、adodb stream
9、其它


.Open "GET", URL 翻譯公司 False
If InStr(TempArray(k - 2 翻譯公司 j), "△") > 0 Or InStr(TempArray(k - 2, j), "▲") > 0 Then Sheets("stock").Cells(i + (k - 1), j + 2).Font.Color = -16776961
' ==========================================================
您有先下載附檔跑看看嗎??


5/4補充，若是拿這個範列去抓別的網站資料

...
.setRequestHeader "If-Modified-Since" 翻譯公司 "Sat, 1 Jan 2000 00:00:00 GMT"
Else
Debug.Print Timer - t

Do Until .readyState = 4: DoEvents: Loop
Stockname(k - 2) = Replace(Right(Split(.responsetext, "_手藝指標")(0), 11), Chr(13) & Chr(10), "")
HTMLsourcecode.body.innerhtml = convertraw(.ResponseBody)
不外，有些網頁的資料是 load 以後，有一小段 Ajax 會再去抓資料以後 才算真 翻譯完成，這第六種方法可能會抓不到資料

For m = 1 To 4
(5/28 107樓，增添臺灣證券生意業務所三大法人生意超日報html下載典範，可和21樓比力看看有什麼分歧)
可以給我網站嗎，我想試試如果用 msxml2.xmlhttp 不跑多工的話，能不克不及行 翻譯通



HTMLsourcecode.body.innerhtml = .responsetext
(5/27 71樓，增添一個變數，方便獲得名稱)
Next k

6、msxml2.xmlhttp
'網站有亂碼時，把上面這一行刪掉，改用下面這一行

t = Timer
萬一網頁改版無法匯入，請自行想舉措調劑

還有的網站一旦發現抓 特定IP每筆request 翻譯距離時間太短...(恕刪)

不外第四個有個問題就是效力太差，因為要使用 ie 來開，抓一筆資料1~10秒不等
我沒有下載跑跑看，不外我領會你程式的作法，既然你跑過，應當沒有問題
For i = 1 To j

snare wrote:
Set HTMLsourcecode = Nothing
snare wrote:
Sub getstock(firstdata, lastdata)
Function convertraw(rawdata)
...

(11/15 269樓，增加凱基證券，逐日收盤價下載範例)
set GetXml=nothing

(5/30 123樓，增加臺灣證券生意業務所三大法人生意超日報csv下載規範，可和107樓比較看看有什麼分歧)
我利用第六種，不需開ie直接抓取資料

第四個有個問題就是效力太差，因為要使用 ie 來開，抓一筆資料1~10秒不等
Set GetXml = Nothing
附加緊縮檔: 201603/mobile01-ee273354e317f442fa850e52c524c978.zip

解決體例有許多
Dim TempArray2(20, 8)

doevents

這些只是無聊嘗嘗分歧方式，練習 翻譯小品程式

Set rawstr = CreateObject("adodb.stream")


Sheets("stock").Range("b2:l" & lastrow).Value = TempArray()
lastrow = Sheets("stock").Range("a1").CurrentRegion.Rows.Count
我有特殊讓程式碼很輕易修改，剩下的請自行研究
或是
說到痛點了，這些我以前寫程式時都遇過，不過對而今的我都不是問題了
For i = 0 To Table.Length - 1
(6/03 149樓，增添台灣股市資訊網全主動規範 翻譯公司批改71樓毛病)
Debug.Print Timer - ttt
If lastrow Mod 5 > 0 Then j = Int(lastrow / 5) + 1 Else j = Int(lastrow / 5)
...
lastdata = lastrow
(5/28 71樓、75樓，批改一個ReDim TempArray()不應産生 翻譯低級毛病，忘了-1)

這樣只需要載入網頁原始碼，再把表格部份掏出
Next k
我使用第六種，不需開ie直接抓取資料


'HTMLsourcecode.body.innerhtml = convertraw(.ResponseBody)
End Sub
End Sub
(5/26 75樓，增添鉅亨網個股歷史行情快速下載範例)
我想不消試了，每個網站 翻譯對策都不同，遇過前300筆都很快，一旦跨越三百筆就變得超慢的
(6/09 120樓，因公然資訊觀測站，新增了查詢次數限制，增添4行程式碼可間斷程式，避免毛病産生)
Dim delsheet As Worksheet

End Function
翻譯資料筆數又很多

有些網頁的資料是 load 以後，有一小段 Ajax 會再去抓資料以後 才算真 翻譯完成...(恕刪)

***但若是是只想要我協助修改、拿現成的，我一律不回***
Set HTMLsourcecode = Nothing
For k = firstdata To lastdata
For j = 0 To Table(i).Cells.Length - 1
(6/13 170樓，增添幾行程式碼)
If delsheet.Name <> "stock" Then delsheet.Delete

這個也不是沒有解法
For k = firstdata To lastdata
For i = 1 To Table.Length - 1

建議用2016/3/21的版本就好(更新到2017/05/04)
If lastrow Mod 5 > 0 Then j = Int(lastrow / 5) + 1 Else j = Int(lastrow / 5)

就讓我藏私一下，免費的，如許就很好了

End Sub
HTMLsourcecode.body.innerhtml = .responsetext

後來就用 Excel VBA 寫了一個近似 Celery 之類的對象，在 Excel 中使用 VBA 操作 Windows Script Host 開 multi-processes 去抓資料，幾分鐘就抓完了

。-> 翻譯社|,-> 翻譯公司|的-> 翻譯

p.s 這是代替 excel web 匯入用 翻譯，不是拿來抓“數萬筆”資料用的
我的電腦I7+excel 2007，在網路正常的情況下
(5/30 120樓，增添公然資訊觀測站持股讓渡日報表快速下載典範榜樣)
Set Table = HTMLsourcecode.all.tags("table")(m).Rows
Next delsheet
如果資料放在統一工作表，改成只抓一個表格，時候就跟yahoo差不多
End If
If i = 1 Then firstdata = 2 Else firstdata = (i - 1) * 5 + 1
yahoo 100筆(每筆1個表格，1列資料)，約8~15秒
Application.DisplayAlerts = False

TempArray2(i + ((m - 1) * 5) 翻譯公司 j) = Trim(Table(i).Cells(j).innertext)


With rawstr

'===============================================
If i = j Then

Sub delsheet()
End If
您有先下載附檔跑看看嗎??
(*** 請勿轉貼到別 翻譯論譠，only for mobile01，僅可轉貼保持網址，謝謝***)
lastrow = Sheets("stock").Range("a1").CurrentRegion.Rows.Count
有些網站因為編碼 翻譯關係，抓下來的資料，中文會事故碼
Set rawstr = Nothing
set GetXml=CreateObject("msxml2.xmlhttp")

(密技 翻譯公司快速對大量文字改編碼類型)
可有用提高速度，還比excel直接用web匯入還快許多許多
End With
Sheets("stock").Range("b2:l" & lastrow).Clear: Range("n1") = ""
ReDim TempArray(lastrow - 2, 10)
(6/14 175樓，小幅改寫1樓yahoo股價查詢程式碼)

(6/23 200樓，因臺灣證券生意業務所網頁改版，csv沒法用123樓典範榜樣下載，新增另外一種csv下載典範榜樣)
Next i


不保舉利用，單純為了試試另外一種體式格局的瑕疵作品
程式碼就不貼了，歸正沒人看，想看的本身下載

Set HTMLsourcecode = CreateObject("htmlfile")
Sheets("stock").Select
可以google到的類型，基本上都是前4個，因為比較輕易copy、改寫
.Open

With GetXml
(5/10 45樓，“部分程式碼”，合併21樓類型，可快速載入csv檔)
lastdata = (i - 1) * 5 + 5
這行
Next m

' 鉅亨 (2016/3/21 把資料渙散，增添副程式的效率，晉升查詢速度)
您願意下載檔案跑看看，給點定見嗎?是不是有再加快的可能性?

"Do Until .readyState = 4" 翻譯問題，在於碰到一些 https 的網頁會 hang 住 ...(恕刪)
End Sub
TempArray(k - 2, j) = Mid(Split(Table(i).Cells(j).innertext, Chr(13) & Chr(10))(0) 翻譯公司 5, Len(Split(Table(i).Cells(j).innertext 翻譯公司 Chr(13) & Chr(10))(0)))
snare wrote:

For j = 0 To Table(i).Cells.Length - 2
假如有會1~8種以外，其它更好方式 翻譯高手，能幫忙點竄晉升程式效力
If i = 1 And j = 0 Then

Application.DisplayAlerts = True
Set GetXml = CreateObject("msxml2.xmlhttp")

Next i
Next i
Call getstock(firstdata, lastdata)
Wei_1144 wrote:
If i = 1 Then firstdata = 2 Else firstdata = (i - 1) * 5 + 1

(7/1 200樓，增添PtrSafe，讓程式能在excel(64位元)中順遂履行)
我對網頁設計不熟，逗留在排版階段，但 yahoo 鉅亨 測試上是沒問題的

For i = 1 To j
Erase TempArray
.Type = 1
TempArray(k - 2) = TempArray2
TempArray(k - 2, j) = Trim(Table(i).Cells(j).innertext)
我對網頁設計不熟，逗留在排版階段orz，但 yahoo 鉅亨 測試上是沒問題的
(7/6 222樓，太無聊，拿219樓個中一個副程式，做一個表單)
(2017/05/04 小更新，增加亂碼處理體例，趁便多加幾個doevents，)
Global TempArray()

msxml2.xmlhttp + readyState = 4，最多只遇到網頁回應稍慢而己，還沒遇過停止回應
翻譯公司 lastdata)
某個國度的國度藏書樓，我去抓書目資料，我覺得是因為他們系統或網路 翻譯關係，因為每個動作 翻譯回應都不快
End Sub
歡迎討論

'====================================================
lastdata = (i - 1) * 5 + 5
翻譯範例)
.setRequestHeader "Cache-Control", "no-cache"
(不過，能有1500筆股票的，也十分人，不會想用這種小工具)
(11/10 262樓，因鉅亨網“又”改版了，256樓典範失效，請參考peter624(262樓)的點竄體例)
.setRequestHeader "Pragma", "no-cache"
解決體式格局是加入計時，超過時間就跳到下一筆，再回頭重抓
URL = "https://tw.stock.yahoo.com/q/q?s=" & Sheets("stock").Cells(k 翻譯公司 1)
讀入全部的原始碼，再取出表格內容
Wei_1144 wrote:
這些程式碼，純真只是我忽然想複習一下很久沒用msxml2的語法，順便更新算一下本身股票損益

"Do Until .readyState = 4" 翻譯問題，在於碰到一些 https 的網頁會 hang 住，除非 IE config 中設定 為信賴的網域(可是不平安) 翻譯社 網路上有會商，我一時之間找不到資料。
cpu利用率低、不亂性高，連續抓1500筆都不會出問題
(11/11 266樓，沒有更新，無聊發文)
Sheets(Stockname(i)).Range("a1:i19").Value = TempArray(i)

.Write rawdata
Sheets("stock").Range("n1") = "Loading " & Round((i / j) * 100) & "％"

讀入掃數的原始碼，再掏出表格內容
你如同是一筆一筆抓，這樣應當會被 Yahoo ban。

(yahoo + 鉅亨)
DoEvents
因為我是等整網頁載入完成之後 => Do Until .readyState = 4: DoEvents: Loop
相同網站改用 msxml2.xmlhttp + readyState = 4 ，只有載入sourcecode，跟ie比起來，效率最少快50倍
ttt = Timer
.Position = 0
Next i


按照我的考察，彷佛有不少人想要
Dim URL, HTMLsourcecode,GetXml
遇過一個國外的網站 反映速度很慢，回應一筆資料大約需要30秒...(恕刪)

(7/5 219樓，利用比較非凡但較易懂的體例，改寫170樓程式碼)

'=======================================================================
(ie.object 實測後，一樣100筆資料)
'繁體凡是轉成big5就可以了，簡體每每是gb2312
If Worksheets.Count > 1 Then Call delsheet
Sheets("stock").Cells.EntireColumn.AutoFit

' yahoo (2016/3/21 把資料分散，增加副程式 翻譯效力，晉升查詢速度)
If InStr(TempArray(k - 2, j), "▽") > 0 Or InStr(TempArray(k - 2, j), "▼") > 0 Then Sheets("stock").Cells(i + (k - 1) 翻譯公司 j + 2).Font.Color = -11489280

Else
還有的網站一旦發現抓 特定IP每筆request的間隔時候太短 就會擋。良多樣化。
arrow
arrow
    文章標籤
    翻譯社
    全站熱搜
    創作者介紹
    創作者 rachelr35gwe 的頭像
    rachelr35gwe

    rachelr35gwe@outlook.com

    rachelr35gwe 發表在 痞客邦 留言(0) 人氣()

    E-mail轉寄