泰語翻譯
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 去抓資料,幾分鐘就抓完了
我的電腦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
您有先下載附檔跑看看嗎??
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)
讀入全部的原始碼,再取出表格內容
(yahoo + 鉅亨)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。
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的間隔時候太短 就會擋。良多樣化。Wei_1144 wrote:
因為我是等整網頁載入完成以後 => Do Until .readyState = 4: DoEvents: Loop
(8/29 248樓,增添當網站檢查是用vba抓資料,會封閉下載解決體式格局)
.Open "GET" 翻譯公司 URL 翻譯公司 False
(只有yahoo,鉅亨用不到,懶的改了)
我用 ie object + readyState = 4 經常産生,用yahoo 股市測試時就當到我受不了
Sheets.Add(After:=Sheets(Sheets.Count)).Name = Stockname(i)
Sub fake_Multiplex()
固然是測試版,橫豎都寫好了,也懶得最好化處理縮短優化程式碼
lastdata = lastrow
End If
或是闡明ajax看看是去那裡抓資料
With GetXml
根基上不會再更新了,因為自己的股票還不到30筆
若是真 翻譯有這個問題也不難解決,多增添期待時間就好
檢查載入的資料例若有 1~100 ,我只要1、2、3,拿到後直接關閉ie,跳下一筆
請問是網站特別讓回應變慢 or 網路回應慢???
End With
您願意下載檔案跑看看,給點意見嗎?是不是有再加速的可能性?
上班用這類體例偷看股票被發現,後果自行承當,別怪我
.Charset = "big5"
Next j
Sheets("stock").Range("e1") = ""
Erase TempArray2
正常的網站就不要用這個function了,可以節省一點點處置時候
Sub fake_Multiplex()
HTMLsourcecode.body.innerhtml = .Responsetext
Sheets("stock").Range("n1") = lastrow - 1 & " stock loading ok"
snare wrote:
.Type = 2
.send
snare wrote:
For i = 0 To lastrow - 2
我想不用試了,每個網站的對策都分歧,遇過前300筆都很快,一旦跨越三百筆就變得超慢的
.Mode = 3
.send
.setRequestHeader "Cache-Control" 翻譯公司 "no-cache"
而且首要目地只是取代excel web匯入,沒有抓上千筆資料的需求
.Close
(今朝最多只試到1500筆,再多不肯定是否正常,請自行測試)
想拿就拿去用吧,檔案也上傳了,其它網站只要修改小處所就行
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
(7/31 244樓,增添集保戶股權分離表查詢,“偽”多工處置懲罰體例範例)
請問是網站稀奇讓回應變慢 or 網路回應慢???
URL = "http://www.cnyes.com/twstock/Technical/" & Sheets("stock").Cells(k, 1) & ".htm"
Sub getstock(firstdata, lastdata)
以下文章來自: https://www.mobile01.com/topicdetail.php?f=511&t=4737630有關翻譯的問題歡迎諮詢天成翻譯社