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

標題: 直接抓除息表到工作表中不正常 [打印本頁]

作者: t8899 時間: 2017-6-22 12:12 標題: 直接抓除息表到工作表中不正常

股票名稱不正常
Sub 寶來除息表()
Application.ScreenUpdating = False '除權除息表
Application.EnableEvents = False
Application.DisplayStatusBar = False
ActiveSheet.DisplayPageBreaks = False
Dim i As Integer, S As Integer, k As Integer, j As Integer
Dim Element
   With CreateObject("InternetExplorer.Application")
   ' .Visible = True          '可顯示網頁
   .Navigate "http://jdata.yuanta.com.tw/z/ze/zeb/zeb.djhtm"
      Do While .Busy Or .readyState <> 4: DoEvents: Loop
      Set Element = .Document.getElementsByTagName("table")
      On Error Resume Next
      Sheets("sheet1").Range("a:e").ClearContents
      With Sheets("sheet1")
               For S = 2 To 2                   '已找出網頁的table內容在 0-3 中
            For i = 1 To Element(S).Rows.Length - 1
                  k = k + 1
               For j = 0 To 4 '資料的欄位共6位
                     .Cells(k, j + 1) = Element(S).Rows(i).Cells(j).innerText
                  Next
            Next
         Next
      End With
   .Quit
End With
Set Element = Nothing

Application.DisplayStatusBar = True
End Sub
[attach]27366[/attach]

[attach]27367[/attach]

作者: f3202 時間: 2017-6-22 13:09

Sub Click_1()
Dim ie
Sheets(1).Select
Const url As String = "http://jdata.yuanta.com.tw/z/ze/zeb/zeb.djhtm"    ' 正確的
Cells.Delete 'Clear
Set ie = CreateObject("internetexplorer.application") '使用此方式可以免除 "設定引用項目"
With ie
      .Visible = False 'True為開啟ie, False為不開啟ie
      .Navigate url
      Do While .Busy Or .ReadyState <> 4: DoEvents: Loop ' Do While .ReadyState <> 4 '等待網頁開啟
      DoEvents
   '  Loop
      .ExecWB 17, 2 'Select All
      .ExecWB 12, 2 'Copy selection
      Range("A1").Activate
      ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
End With
Columns("A:A").Delete ' 將匯入時 A、B 兩欄移除，原本 C:I 的欄位全部左靠，成為 A:I
ie.Quit
End Sub

作者: t8899 時間: 2017-6-22 14:46

Sub Click_1()
Dim ie
Sheets(1).Select
Const url As String = "http://jdata.yuanta.com.tw/z/z ...
f3202 發表於 2017-6-22 13:09

謝謝，我只要前5欄 A-E 要改那些地方呢?

作者: GBKEE 時間: 2017-6-22 15:57

Sub 寶來除息表()
Application.ScreenUpdating = False '除權除息表
Application.EnableEvents = False
Application.DisplayStatusBar = False
ActiveSheet.DisplayPageBreaks = False
Dim i As Integer, S As Integer, k As Integer, j As Integer
Dim Element
With CreateObject("InternetExplorer.Application")
'.Visible = True '可顯示網頁
.Navigate "http://jdata.yuanta.com.tw/z/ze/zeb/zeb.djhtm"
Do While .Busy Or .readyState <> 4: DoEvents: Loop
Set Element = .Document.getElementsByTagName("table")(2) ' 已找出網頁的table內容在 0-3 中
Sheets("sheet1").Cells.ClearContents
With Sheets("sheet1")
For i = 1 To Element.Rows.Length - 1
For j = 0 To Element.Rows(i).Cells.Length - 1
If j = 0 And i > 2 Then
.Cells(i, j + 1) = Element.all.tags("a")(i - 3).innertext
Else
.Cells(i, j + 1) = Element.Rows(i).Cells(j).innertext
End If
Next
Next
End With
.Quit
End With
Set Element = Nothing
Application.DisplayStatusBar = True
End Sub

複製代碼

回復 1# t8899

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)