搜尋
搜尋
  • 156

(不定期更新)使用VBA解決 excel web 查詢無法匯入、匯入太慢的股市資料

前往頁尾
snare
snare
snare
  • snare
  • 個人積分：3057分
    文章編號：90545578
3057分
樓主
2024-10-28 7:56
Morten Hsu wrote:
我嘗試用您75樓的 Sub getpost() 下載個股成交資訊，但是增列一欄為平均股價，用第9欄的成交金額/第8欄的成交量計算, 但是執行結果只在工作表第11欄填上欄位名稱，資料則空白一片。用 Debug.Print "平均股價：" & TempArray(i, 11) 驗證，但是即時運算顯示的運算結果卻是錯的。雖然 20220217改的 Get_cnyes_Jsondata也可以添加一欄取得vwap的資料，我希望能知道問題出在哪裡，因為ChatGPT也束手無策。更改後的代碼如下：


錯誤1
陣列如果沒有特別指定，是從0開始，所以您全部的位置都+1

錯誤2
原始資料中有逗號，不能用val()，會出錯



…… 略……
' 修改：只新增一欄，用於 K 欄的平均股價
ReDim TempArray(Table.Length - 1, Table(2).Cells.Length + 0)

…… 略……
If TempArray(i, 7) > 0 And TempArray(i, 8) > 0 Then ' 確保 "成交量" 和 "成交金額" 都不為 0
TempArray(i, 10) = Round(TempArray(i, 8) / TempArray(i, 7), 2)

…… 略……
TempArray(i, 10) = "N/A" ' 若成交量或成交金額為 0，顯示 "N/A"
' 填充 K 欄（平均股價）

…… 略……
'.Range(.Cells(2, 11), .Cells(Table.Length, 11)).Value = Application.Index(TempArray, 0, 11)






Morten Hsu wrote:

另外，再請教本例一個問題：在With Getxml區塊內
.Open "POST", Url, False
.setRequestHeader "Referer", Url
.send (Url_a)
Open "POST"已經用Url，setRequestHeader "Referer"為何還是Url，不是Url_a，而是.send (Url_a)？


75樓，2017年的古董範例，真正原因是什麼我忘了
應該是當初要檢查 "Referer"，剛好就是 UrL ，剛測試刪掉也正常不需要了
但網頁改版多次，要完整資料，還是要改用json版的範例

.send (Url_a)
url_a，是因為我懶，沒重新定義新名稱，拿現在變數直接用
Morten Hsu
Morten Hsu

大師 您好： 非常感謝您，從您這裡真的可以學到很多東西，我功底不夠必須從底層學起，看著1千5百多樓層，還有好多要學習的。真謝謝大師的教導。

2024-10-28 8:16
Morten Hsu
Morten Hsu

大師您好：謝謝您，計算錯誤的地方也找到了，原來是下載的數據帶有千分號被當成逗號處理了。一個範例就學到很多，非常感謝您無私的付出。

2024-10-28 18:30
Morten Hsu
Morten Hsu
Morten Hsu
0分
1512樓
2024-10-31 10:49
snare wrote:
20200410 更...(恕刪)

Snare 大師您好：
颱風天在家剛好可以好好學習VBA，繼上次 Sub getpost() 的問題，在請教同為75樓的 Sub Get_cnyes_Jsondata()，只稍作修改。但是，開始日期的下一個營業日的成交紀錄總是留白，以及vwap的值不知何故，有時候有數值，有時候是 null。部分代碼如下：
With Xmlhttp
.Open "GET", Url, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Referer", Url_a
.send

' 即時運算列印回應的原始 JSON 字串
Debug.Print "Response Text: " & .responsetext

' 解析JSON數據
Set DecodeJson = CallByName(Jsondata.JsonParse(.responsetext), "data", VbGet)

' 查看 DecodeJson 的 vwap 結構
Dim vwapArray As Object
Set vwapArray = CallByName(DecodeJson, "vwap", VbGet)

If vwapArray Is Nothing Then
Debug.Print "vwap array is empty or does not exist"
Else
For i = 0 To CallByName(vwapArray, "length", VbGet) - 1
If IsNull(CallByName(vwapArray, i, VbGet)) Then
Debug.Print "vwap element " & i & ": null"
Else
Debug.Print "vwap element " & i & ": " & CallByName(vwapArray, i, VbGet)
End If
Next i
End If

End With


With Sheets("工作表1")
Application.ScreenUpdating = False

For i = 0 To CallByName(CallByName(DecodeJson, "t", VbGet), "length", VbGet) - 1

.Cells(i + 4, 1) = Format(CallByName(CallByName(DecodeJson, "t", VbGet), i, VbGet) / 86400 + #1/1/1970 8:00:00 AM#, "yyyy/mm/dd")
.Cells(i + 4, 2) = CallByName(CallByName(DecodeJson, "o", VbGet), i, VbGet)
.Cells(i + 4, 3) = CallByName(CallByName(DecodeJson, "h", VbGet), i, VbGet)
.Cells(i + 4, 4) = CallByName(CallByName(DecodeJson, "l", VbGet), i, VbGet)
.Cells(i + 4, 5) = CallByName(CallByName(DecodeJson, "c", VbGet), i, VbGet)
If i > 0 Then
.Cells(i + 4 - 1, 6) = .Cells(i + 4 - 1, 5) - .Cells(i + 4, 5)
.Cells(i + 4 - 1, 7) = Round((.Cells(i + 4 - 1, 6) / .Cells(i + 4, 5)) * 100, 2) & "%"

If .Cells(i + 4 - 1, 6) > 0 Then
.Cells(i + 4 - 1, 5).Font.Color = vbRed
.Cells(i + 4 - 1, 6).Font.Color = vbRed
.Cells(i + 4 - 1, 7).Font.Color = vbRed
End If
If .Cells(i + 4 - 1, 6) < 0 Then
.Cells(i + 4 - 1, 5).Font.Color = -11489280
.Cells(i + 4 - 1, 6).Font.Color = -11489280
.Cells(i + 4 - 1, 7).Font.Color = -11489280
End If
End If
.Cells(i + 4, 8) = CallByName(CallByName(DecodeJson, "v", VbGet), i, VbGet)

' 填入 vwap 數值到 Excel 中
If IsNull(CallByName(vwapArray, i, VbGet)) Then
.Cells(i + 4, 9) = "N/A" ' 如果是 null，填入 "N/A"
Else
.Cells(i + 4, 9) = CallByName(vwapArray, i, VbGet) ' 否則填入實際的值
End If

Next i

'debug
.Cells(1, 1) = stock & " " & CallByName(CallByName(DecodeJson, "quote", VbGet), "200009", VbGet) ' 從 quote 部分提取證券名稱
.Cells(2, 1) = "開始日期：" & startday 'Format(.Cells(i, 1), "yyyy/mm/dd")
.Cells(2, 4) = "結束日期: " & endday 'Format(.Cells(2, 1), "yyyy/mm/dd")

.Rows(i + 1).Clear
'.Cells.EntireColumn.AutoFit
.Cells(1, 1).Select

Application.ScreenUpdating = True

End With
oliwa
oliwa
oliwa
  • oliwa
  • 個人積分：1分
    文章編號：90564403
1分
1513樓
2024-10-31 11:34
Snare 大大好 , 又要來請教 ,
因交易所改版 , 原 CSV 的 URL 無法使用 , 嘗試 chrome F12 找資料 , 但找到的 URL 無法正常下載資料
櫃買交易所 , 每日行情 , https://www.tpex.org.tw/zh-tw/mainboard/trading/info/pricing.html
自行找到的 URL 無法下載資料 , 麻煩 S 大協助 , 感謝 !!


oliwa
oliwa

S 大 , 還有興櫃資料也一樣情況 , https://www.tpex.org.tw/zh-tw/esb/trading/info/pricing.html , 也請協助 , 感謝 !!

2024-10-31 11:36
snare
snare
snare
  • snare
  • 個人積分：3057分
    文章編號：90568669
3057分
樓主
2024-11-01 8:09
Morten Hsu wrote:
Get_cnyes_Jsondata()，只稍作修改。


vwap加一行就行





Morten Hsu wrote:
開始日期的下一個營業日的成交紀錄總是留白，以及vwap的值不知何故，有時候有數值，有時候是 null。：


我隨便試幾個日期，沒發現，請給我出問題的日期
snare
snare
snare
  • snare
  • 個人積分：3057分
    文章編號：90568670
3057分
樓主
2024-11-01 8:10
oliwa wrote:
因交易所改版 , 原 CSV 的 URL 無法使用











(20241102)
做點小修正，加2個doevents，可改善連續下載不同資料時的 PasteSpecial 方法失敗
如需多次下載，建議每次之間加上適當的延遲。

[點擊下載]
oliwa
oliwa

謝謝 S 大 , 我先試試 , tks .

2024-11-03 22:53
jeremy5
jeremy5

JSON, https://www.tpex.org.tw/www/zh-tw/afterTrading/dailyQuotes?l=zh-tw&s=0,asc,0&o=json&date=2025/10/30

2025-08-21 16:26
Morten Hsu
Morten Hsu
Morten Hsu
0分
1516樓
2024-11-01 16:29

snare wrote:
vwap加一行就行我...(恕刪)

大師 您好：
謝謝您，空白行就是固定出現在開始日期的下一個營業日。圖片是以20241016為開始日期，就會在20241017出現空白。
snare
snare
snare
  • snare
  • 個人積分：3057分
    文章編號：90574310
3057分
樓主
2024-11-02 8:45
Morten Hsu wrote:
圖片是以20241016為開始日期，就會在20241017出現空白。


20241016開始，您怎麼會抓到20241015的資料?

也許是您程式的問題，我用get_cnyes_json那個範例，測試沒這個情況


Morten Hsu
Morten Hsu
Morten Hsu
0分
1518樓
2024-11-02 20:57
snare wrote:
20241016開始...(恕刪)

Snare大師 您好：
對不起，剛剛的留言送出後不知為何是一片空白。重新編輯如下：
您的原始程式get_cnyes_Jsondata是正確無誤。而我是做了如下變更：
1. 把證券號碼和證券名稱從 Cells(1, 10) 移到 Cells(1, 1)
2. 把開始日期從 Cells(1, 11) 移到 Cells(2, 1)
3. 把結束日期從 Cells(1, 12) 移到 Cells(2, 4)
4. 欄位名稱從 Range("A1:H1") 移到 Range("A3:H3")
因此，整個表格往下移，所以又變更了
5. Cells(i + 2, 1) 到 Cells(i + 2, 8) 改為 Cells(i + 4, 1) 到 Cells(i + 4, 8)，也因為這個改變，造成開始日期的下一個營業日資料空白的錯誤。試了大半天，還是毫無頭緒，又麻煩大師了，謝謝您。
snare
snare 樓主

是的，但是會少資料，因為最後一筆需要前一天的資料計算。所以在程式碼中開始日期要減一天。

2024-11-03 12:15
Morten Hsu
Morten Hsu

謝謝大師解惑。

2024-11-03 14:25
oliwa
oliwa
oliwa
  • oliwa
  • 個人積分：1分
    文章編號：90583107
1分
1519樓
2024-11-04 11:20
S 大大 , 以下有檢查過 , 執行後卻出現 "物件不支援此屬性或方法" , 沒並有停在那一行 , 而工作表中僅有一個 X 在 A2 欄位 , 請 S 大協助 , 感謝 !!

Sub Get_tpex_Csv()
Dim Clipboard As Object, XmlHttp As Object, URL As String, URL_a As String
Set Clipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Set XmlHttp = CreateObject("Msxml2.XMLHTTP")

On Error GoTo checkid
Application.ScreenUpdating = False
Sheets("工作表1").Cells.Clear
Call Stop_TextToColumns

URL = "https://www.tpex.org.tw/www/zh-tw/afterTrading/dailyQuotes?date=2024/10/30&id=&response=csv"
URL_a = "https://www.tpex.org.tw/zh-tw/mainboard/trading/info/pricing.html"

'URL = "https://www.tpex.org.tw/www/zh-tw/emerging/latest?id=&response=csv"
'URL_a = "https://www.tpex.org.tw/zh-tw/esb/trading/info/pricing.html"

With XmlHttp
.Open "GET", URL, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Referer", URL_a
.setRequestHeader "User-Agent", "Mozilla/5.0(Windows NT 10.0;Win64; x64) AppleWebKit/537.36(KHTML, like Gecko) Crhome/128.0.0.0 Safari/537.36"
'.setRequestHeader "Cache-Control", "no-cache"
'.setRequestHeader "Pragma", "no-cache"
'.setRequestHeader "If-Modified-Since", "Sat,1 Jan 2000 00:00:00 GMT"
.send
End With

With Clipboard
.SetText convertraw(XmlHttp.responsebody)
.PutlnClipboard
End With

With Sheets("工作表1")
.Cells(1, 1).Select
.PasteSpecial NoHTMLFormating:=True
.Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Comma:=True, FieldInfo:=Array(Array(1, 2)), TrailingMinusNumbers:=True
.Cells(1, 1).Select
.Columns.AutoFit
.Columns("A:A").ColumnWidth = 25
End With

Application.ScreenUpdating = True
Set Clipboard = Nothing
Set XmlHttp = Nothing

checkid:
If Err.Number <> 0 Then
Debug.Print Err.Description
End If

End Sub

Function convertraw(rawdata)
Dim rawstr
Set rawstr = CreateObject("adodb.stream")
With rawstr
.Type = 1
.Mode = 3
.Open
.Write rawdata
.Position = 0
.Type = 2
.Charset = "big5"
covertraw = .ReadText
.Close
End With
Set rawstr = Nothing
End Function

Sub Stop_TextToColumns()
With Sheets("工作表1").Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Value = "X"
.textcolumns , xlDelimited, xlTextQualifierDoubleQuote, False, True, False, False, False, False, , Array(1, 1)
.Clear
End With
End Sub
oliwa
oliwa

S大 , 成功下載了 , 非常感謝 !!

2024-11-04 22:38
oliwa
oliwa

感謝 S 大 , 成功套用至原來使用的程式內了 , 可以正常更新每日收盤價 !! 感恩 !!

2024-11-05 16:40
nijawang
nijawang
nijawang
  • nijawang
  • 個人積分：1231分
    文章編號：90612352
1231分
1520樓
2024-11-09 11:27
nijawang wrote:snare 大，
這幾天發現從 Yahoo! Finance 抓到的 Json 資料跟網頁的不同
不知道是不是 Yahoo! 又改了什麼？
snare大，
最近的Yahoo!Finance又出現同樣的資料錯誤問題
主要是ETF出錯；股票資料看起來正確。

試了幾支ETF，發現資料出錯的方式不同，
不知道是網頁的資料就錯誤，還是抓資料的方式又需要更動？

BND：DecodJson1抓到VXUS的資料
BNDW：一直抓到10/22的資料
BNDX：陣列索引超出範圍(temp中無內容)
BWX：同BNDX
SCHP：同BNDX
QLD：一直抓到11/1的資料
VWO：一直抓到10/14的資料

文字檔
[點擊下載]
Excel檔
[點擊下載]
  • 156
內文搜尋
搜尋
從 APP 打開從 APP 打開
X
X
加入好友名單
取消 確定
評分
取消 確定
評分
取消 確定
複製連結
複製
請輸入您要前往的頁數(1 ~ 156)
確定
留言回報
取消 確定
Mobile01提醒您
您目前瀏覽的是行動版網頁
是否切換到電腦版網頁呢?
否 是