麻辣家族討論版版 - Powered by Discuz! Board

Option Explicit
'加權指數法人買賣超日統計圖- Goodinfo!台灣股市資訊網
Const 法人買賣 = "http://goodinfo.tw/StockInfo/ShowBuySaleChart.asp?STOCK_ID=%E5%8A%A0%E6%AC%8A%E6%8C%87%E6%95%B8&CHT_CAT=DATE"
'加權指數融資融券餘額日統計圖 - Goodinfo!台灣股市資訊網
Const 融資融券 = "http://goodinfo.tw/StockInfo/ShowBearishChart.asp?STOCK_ID=%E5%8A%A0%E6%AC%8A%E6%8C%87%E6%95%B8&CHT_CAT=DATE"
Sub Ex_台灣股市資訊網()
Dim i As Integer, b As Object, E As Object, R As Integer, Ar, A As Variant
Dim ie, Ay(), k As Integer
Ay = Array(法人買賣, 融資融券)
'Set ie = CreateObject("InternetExplorer.Application")
With CreateObject("InternetExplorer.Application")
.Visible = True
For k = 1 To 2
.Navigate Ay(k - 1)
Do While .Busy Or .readyState <> 4: DoEvents: Loop
Do
Set E = .Document.getElementsByTagName("table")
Loop While E Is Nothing
With Sheets(k)
.Cells.Clear
R = 1
'Ar = Array(18, 21, 23, 30) '法人買賣 30,融資融券 29
Ar = Array(18, 21, 23, IIf(k = 1, 30, 29))
For Each A In Ar
For Each b In E(A).Rows
For i = 0 To b.Cells.Length - 1
.Cells(R, i + 1) = b.Cells(i).innertext
Next
R = R + 1
Next
R = R + 1
Next
End With
Next
.Quit '關閉網頁
End With
End Sub

複製代碼

Option Explicit
Const 個股月營收 = "http://goodinfo.tw/StockInfo/ShowSaleMonChart.asp?STOCK_ID="
'加權指數法人買賣超日統計圖
Const 法人買賣 = "http://goodinfo.tw/StockInfo/ShowBuySaleChart.asp?CHT_CAT=DATE&STOCK_ID="
'加權指數融資融券餘額日統計圖
Const 融資融券 = "http://goodinfo.tw/StockInfo/ShowBearishChart.asp?CHT_CAT=DATE&STOCK_ID="
Sub Ex() 'Goodinfo!台灣股市資訊網
Dim i As Integer, b As Object, E As Object, R As Integer, Ar, A As Variant
Dim ie, Ay(), k As Integer, STOCK_ID As String, Msg As Boolean
Do
STOCK_ID = InputBox("輸入個股代號", "個股代號", 3481)
Loop Until Val(STOCK_ID) And Len(STOCK_ID) >= 4
Ay = Array(個股月營收 & STOCK_ID, 法人買賣 & STOCK_ID, 融資融券 & STOCK_ID)
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
For k = 1 To 3
.Navigate Ay(k - 1)
Do While .Busy Or .readyState <> 4: DoEvents: Loop
With .Document.BODY
If InStr(.INNERTEXT, "查無") Then
Msg = True
GoTo Er
End If
End With
Do
Set E = .Document.getElementsByTagName("table")
Loop While E Is Nothing
If Sheets.Count < k Then Sheets.Add after:=Sheets(Sheets.Count)
With Sheets(k)
.Cells.Clear
R = 1
If k = 1 Then '個股月營收
Ar = Array(13, 20)
ElseIf k = 2 Then '法人買賣
Ar = Array(19, 22, 24, 31)
Else '融資融券
Ar = Array(19, 22, 24, 30)
End If
For Each A In Ar
For Each b In E(A).Rows
For i = 0 To b.Cells.Length - 1
' If InStr(b.Cells(i).INNERTEXT, "資料日期: 無交易資料") Then
' Msg = True
' GoTo Er
' End If
.Cells(R, i + 1) = b.Cells(i).INNERTEXT
Next
R = R + 1
Next
R = R + 1
Next
End With
Next
Er: ' Title
MsgBox Split(.Document.Title, "-")(0) & IIf(Msg, "查無相關資料", " 下載 ok")
.Quit '關閉網頁
End With
End Sub

複製代碼