Chien-Ming Chang wrote:
而愛喔喔遏止嗷嗷愛歐(恕刪)
不好意思，自從出來玩之後，我幾百年沒回去火星了
沒想到現在母語都變了，我看不懂您要問什麼
tmwcykixe wrote:
https://www.boerse-frankfurt.de/equities/search
這個網頁直接放棄ie了
，ie打不開簡單的createobject( internetexplorer.application )也不能用
不好意思，以我的能力
想不到在這個網頁在不另加函式庫，只用"純vba"下載的辦法(除非網頁又改成相容舊版)
找出api網址、參數(json格式)，都可以簡單的用chrome f12追踨到
而問題是vba xmlhttp，雖然沒用到ie，但是相關protocol，是共用的
所以ie打不開的網頁，vba xmlhttp也打不開
網頁在handshake時，就直接失敗，vba send不出去
目前有幾個方式可用(建議，另找來源)
一、另找來源
二、vba + seleniumbasic + chrome web driver
這裡有boerse-frankfurt seleniumbasic 下載範例
https://www.wiseowl.co.uk/vba-macros/videos/vba-scrape-websites/scraping-web-pages/
三、python + selenium + web driver
四、python + 這個網頁專用下載套件(不確定有沒有高手寫出來)
用下程序除 b=A 外 設b=D ;b=W ;b=M 多可以抓到資料
將https://jdata.yuanta.com.tw/Z/ZC/ZCW/CZKC1.djbcd?a=1101&b=A&c=1440 放到IE 有顯示資料 ; 不知哪裡沒寫好? 能否請Snare大抽空指導 謝謝!
Sub 抓股價()
Dim web
Dim url As String
Dim i As Long, j As Integer
On Error Resume Next
' 清空 TEMP
Sheets("temp").Select
Range("a2:f65536").Select
Selection.ClearContents
url = "https://jdata.yuanta.com.tw/Z/ZC/ZCW/CZKC1.djbcd?a=1101&b=D&c=1440"
'url = "https://jdata.yuanta.com.tw/Z/ZC/ZCW/CZKC1.djbcd?a=1101&b=A&c=1440"
'MsgBox url
'網址 http://jsstock.wls.com.tw/Z/ZC/ZCW/CZKC1.djbcd?a=1101&b=A&c=1440
'網址中的代碼1101、K線類型A、K棒天數1440屆時都是要挖洞的部分
' "D" >日線 "W">週線 "M">月線 "A">還原日線 "5">5分鐘 "10">10分鐘 "30">30分鐘 "60">60分鐘
Set web = CreateObject("Microsoft.XMLHTTP")
web.Open "get", url, False
web.send
ReDim Arr(1 To 1440, 1 To 6)
'ReDim arr(1 To Int((Len(web.responseText) - Len(Replace(web.responseText, ",", ""))) / _
(Len(web.responseText) - Len(Replace(web.responseText, " ", "")) + 1)) + 1, 1 To 6)
For i = 1 To 6
For j = 1 To 1440
'For j = 1 To Int((Len(web.responseText) - Len(Replace(web.responseText, ",", ""))) / _
(Len(web.responseText) - Len(Replace(web.responseText, " ", "")) + 1)) + 1
Arr(j, i) = Application.Index(Split(Application.Index(Split(web.responseText, " "), 1, i), ","), 1, j)
Next j
Next i
Range(Cells(2, 1), Cells(1441, 6)) = Arr
Cells(1, 1) = "日期"
Cells(1, 2) = "開盤"
Cells(1, 3) = "最高"
Cells(1, 4) = "最低"
Cells(1, 5) = "收盤"
Cells(1, 6) = "成交量"
With ActiveSheet
.Columns("A:A").NumberFormatLocal = "yyyy/mm/dd"
' .UsedRange.Columns.AutoFit
' .Cells(1, 1).Select
End With
Set web = Nothing
MsgBox "ok"
End Sub
alantsai5840 wrote:
用下程序除 b=A 外 設b=D ;b=W ;b=M 多可以抓到資料
資料長度不一樣，陣列設定錯誤
Sub test()
Dim web As Object, url As String, temp, i As Integer, LastRow As Integer
Cells.Clear
Range("a1:f1") = Array("日期", "開盤", "最高", "最低", "收盤", "成交量")
Application.ScreenUpdating = False
url = "https://jdata.yuanta.com.tw/Z/ZC/ZCW/CZKC1.djbcd?a=1101&b=A&c=1440"
'b=A、D、W、M
Set web = CreateObject("Microsoft.XMLHTTP")
web.Open "get", url, False
web.send
temp = Split(web.responsetext, " ")
LastRow = Len(temp(0)) - Len(Replace(temp(0), ",", ""))
Debug.Print LastRow
For i = 0 To 5
Range("a2:a" & LastRow + 2).Offset(, i) = WorksheetFunction.Transpose(Split(temp(i), ","))
Next i
Application.ScreenUpdating = True
Set web = Nothing
End Sub
g80860 wrote:
指定儲存格只要有出現訊息時(非每秒記錄,平常是空白),,,,,自動記錄指定工作表之儲存格.(恕刪)
https://www.mobile01.com/topicdetail.php?f=511&t=6435783
Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, ThisWorkbook.Sheets("工作表1").Range("a1")) Is Nothing Or _
ThisWorkbook.Sheets("工作表1").Range("a1") = "" Then
Exit Sub
Else
Call Record
End If
End Sub
Sub Record()
ThisWorkbook.Sheets("工作表2").Range("b2") = ThisWorkbook.Sheets("工作表1").Range("a1")
End Sub
Sub test()
ThisWorkbook.Sheets("工作表1").Range("a1") = Rnd(Timer)
End Sub
我想要使用excel VBA用web匯入goodinfo網頁的資料
抓取單一股票的三大法人最近6個月的買賣超張數資料
程式碼如下:
程式第五行出現錯誤...無法執行
若將第五行忽略...跑出來卻出現亂碼
請各位高手幫忙看程式哪個地方需要修改?
感激不盡...
Sub 三法()
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;https://goodinfo.tw/StockInfo/ShowBuySaleChart.asp?STOCK_ID=2303&CHT_CAT=DATE" _
, Destination:=Range("$A$2"))
.CommandType = 0
.Name = "ShowBuySaleChart.asp?STOCK_ID=2303&CHT_CAT=DATE"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "24"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
jy598028 wrote:
若將第五行忽略...跑出來卻出現亂碼
請看1079樓的說明
jy598028 wrote:
我想要使用excel VBA用web匯入goodinfo網頁的資料
抓取單一股票的三大法人最近6個月的買賣超張數資料
1044樓範例，修改4行
Url = "https://goodinfo.tw/StockInfo/ShowBuySaleChart.asp?STOCK_ID=" & Stock & "&CHT_CAT=DATE"
Url_a = "https://goodinfo.tw/StockInfo/ShowBuySaleChart.asp?STOCK_ID=" & Stock & "&CHT_CAT=DATE&SHEET=三大法人買賣張數&STEP=DATA&PERIOD=180"
'PERIOD=90、PERIOD=180、PERIOD=365
'(注意一下url_a，如果漏字，請看圖片補上)
Set Table = HTMLsourcecode.getElementById("divBuySaleDetail")
Set Table = HTMLsourcecode.all.tags("table")(2).Rows
內文搜尋
從 APP 打開
X