snare wrote:
chrome.FindElementByXP...(恕刪)
Snare大師您好：
非常感謝您，在網頁上不用按查詢鍵，資料就會轉換，原來VBA還要執行一次Click，而且是用同一個表格(22)。
我在試試看，再次謝謝您。
snare wrote:
不知道，我跑很正常，...(恕刪)
Snare大師:
謝謝您提供關閉廣告問題的解決方式。我再嘗試看看，只是先請教2個問題：
1. 定義的stock為什麼是 stock As String, table, TempArray？
2. 假設 stock, startDate and endDate 相同，而我要同時下載"資券餘額"和"借券資訊"到對應的工作表。那麼， table和TempArray要分成 table1, table2 或 TempArray1, TempArray2 各自定義嗎？
Morten Hsu wrote:
1. 定義的stock為什麼是 stock As String, table, TempArray？
佔用記憶體大小、執行效率、方便寫程式、避免打錯字…
嚴謹一點的還要加上 Option Explicit
詳細請google vba dim、google vba dim Option Explicit
Morten Hsu wrote:
2. 假設 stock, startDate and endDate 相同，而我要同時下載"資券餘額"和"借券資訊"到對應的工作表。那麼， table和TempArray要分成 table1, table2 或 TempArray1, TempArray2 各自定義嗎？
同一個也行，各自定義也行
參考您的文章使用Selenium寫了一段想要抓取損益表中的下拉式選單(合併報表-單季&2024Q2)，不過執行的速度很慢，請問有更好的方式調整嗎?
Sub test()
' 宣告變數
Dim bot As New Selenium.ChromeDriver
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("acc") ' 將數據貼到Sheet "acc" 中
Dim stock_id As String
' 從儲存格 B1 中讀取股票代號
stock_id = Range("B1").Value
' 檢查股票代號是否為空
If stock_id = "" Then
MsgBox "請在儲存格 B1 中輸入股票代號", vbExclamation
Exit Sub
End If
' 構造網址，將股票代號插入網址中
Dim url As String
url = "https://goodinfo.tw/tw/StockFinDetail.asp?RPT_CAT=IS_M_QUAR_ACC&STOCK_ID=" & stock_id
' 打開瀏覽器並導航至目標網址
bot.Start "chrome"
bot.Get url
' 選擇 "合併報表 - 單季"
On Error Resume Next
bot.FindElementByXPath("/html/body/table[2]/tbody/tr[2]/td[3]/main/div[2]/section/div[1]/div/nobr/select[1]/option[1]").Click
' 選擇 "2024Q2"
bot.FindElementByXPath("/html/body/table[2]/tbody/tr[2]/td[3]/main/div[2]/section/div[1]/div/nobr/select[2]/option[1]").Click
On Error GoTo 0
' 等待頁面加載 (減少等待時間至1秒)
Application.Wait (Now + TimeValue("0:00:01"))
' 找到表格元素
Dim table As Object
Set table = bot.FindElementByXPath("/html/body/table[2]/tbody/tr[2]/td[3]/main/div[2]/section/div[2]/div/table[1]")
' 解析表格數據
Dim rows As Object, row As Object
Set rows = table.FindElementsByTag("tr")
Dim r As Long, c As Long
r = 1
' 遍歷表格中的行
For Each row In rows
Dim cols As Object, col As Object
' 初始化列計數
c = 1
' 先檢查表頭()標籤
Set cols = row.FindElementsByTag("th")
If cols.Count > 0 Then
' 如果存在表頭 ()
For Each col In cols
ws.Cells(r, c).Value = col.Text
c = c + 1
Next col
End If
' 再檢查單元格數據 ()標籤
Set cols = row.FindElementsByTag("td")
If cols.Count > 0 Then
' 如果存在數據 ()
For Each col In cols
ws.Cells(r, c).Value = col.Text
c = c + 1
Next col
End If
' 移動到下一行
r = r + 1
Next row
' 結束並關閉瀏覽器
bot.Quit
MsgBox "數據提取完成！", vbInformation
End Sub
snare wrote:
20200410 更...(恕刪)
Snare大師 您好：
我嘗試用您75樓的 Sub getpost() 下載個股成交資訊，但是增列一欄為平均股價，用第9欄的成交金額/第8欄的成交量計算, 但是執行結果只在工作表第11欄填上欄位名稱，資料則空白一片。用 Debug.Print "平均股價：" & TempArray(i, 11) 驗證，但是即時運算顯示的運算結果卻是錯的。雖然 20220217改的 Get_cnyes_Jsondata也可以添加一欄取得vwap的資料，我希望能知道問題出在哪裡，因為ChatGPT也束手無策。更改後的代碼如下：
With Getxml
.Open "POST", Url, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Referer", Url
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send (Url_a)
HTMLsourcecode.body.innerhtml = .Responsetext
'Debug.Print "HTMLsourcecode=" & HTMLsourcecode.body.innerhtml
Title = stock & HTMLsourcecode.getelementbyid("ctl00_ContentPlaceHolder1_titleLab").innertext
Set Table = HTMLsourcecode.all.tags("table")(0).Rows
' 修改：只新增一欄，用於 K 欄的平均股價
ReDim TempArray(Table.Length - 1, Table(2).Cells.Length + 1)
' 填充數據，並計算 "平均股價"
For i = 0 To Table.Length - 1
For j = 0 To Table(i).Cells.Length - 1
TempArray(i, j) = Table(i).Cells(j).innertext
' 顏色設置
If (i > 0 And j = 5) Then
With Sheets("sheet1")
If TempArray(i, j) > 0 Then .Range(.Cells(i + 1, 5), .Cells(i + 1, 7)).Font.Color = -16776961
If TempArray(i, j) < 0 Then .Range(.Cells(i + 1, 5), .Cells(i + 1, 7)).Font.Color = -11489280
End With
End If
Next j
' 計算 "平均股價"（K欄，第11欄，成交金額 / 成交量）
If i > 0 Then ' 略過標題行
If Val(TempArray(i, 8)) > 0 And Val(TempArray(i, 9)) > 0 Then ' 確保 "成交量" 和 "成交金額" 都不為 0
TempArray(i, 11) = Round(Val(TempArray(i, 9)) / Val(TempArray(i, 8)), 2)
Debug.Print "平均股價：" & TempArray(i, 11) ' 即時運算列印
Else
TempArray(i, 11) = "N/A" ' 若成交量或成交金額為 0，顯示 "N/A"
Debug.Print "平均股價：N/A"
End If
End If
Next i
' 將數據寫入工作表
With Sheets("sheet1")
' 填充數據至 A:K 欄
.Range(.Cells(1, 1), .Cells(Table.Length, Table(2).Cells.Length + 1)) = TempArray()
' 新增 "平均股價" 標題
.Cells(1, 11).Value = "平均股價"
' 填充 K 欄（平均股價）
.Range(.Cells(2, 11), .Cells(Table.Length, 11)).Value = Application.Index(TempArray, 0, 11)
End With
End With
另外，再請教本例一個問題：在With Getxml區塊內
.Open "POST", Url, False
.setRequestHeader "Referer", Url
.send (Url_a)
Open "POST"已經用Url，setRequestHeader "Referer"為何還是Url，不是Url_a，而是.send (Url_a)？
內文搜尋
從 APP 打開
X