返回列表 上一主題 發帖

有辦法使用vba匯入外部web資料嗎？

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 2013-1-6 15:33 | 顯示全部帖子
回復 3# gkld
試試看
  1. Option Explicit
  2. Sub 個別現金流量表()
  3.     Dim i, r As Integer, A As Variant, AA As Variant
  4.     With CreateObject("InternetExplorer.Application")
  5.         .Navigate "http://mops.twse.com.tw/mops/web/t05st36"
  6.         .Visible = True
  7.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  8.         With .Document
  9.             .getelementsbytagname("input")(38).Value = "2030"  '這裡修改 股票代號
  10.             .getelementsbytagname("input")(41).Click
  11.         End With
  12.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  13.       
  14.       '******************************
  15.         r = 1
  16.         Cells.Clear
  17.         A = Split(.Document.getelementsbytagname("table")(16).innertext, vbLf)
  18.         For i = 0 To UBound(A)
  19.                 AA = Trim(A(i))
  20.                 Do While InStr(AA, Space(5))
  21.                     AA = Replace(AA, Space(5), Space(4))
  22.                 Loop
  23.                 AA = Split(AA, Space(2))
  24.                 Cells(r, 1).Resize(, UBound(AA) + 1) = AA
  25.                 r = r + 1
  26.         Next
  27.        .Quit
  28.         End With
  29.     '******************************
  30.      資料整理
  31. End Sub
  32. Private Sub 資料整理()
  33.     Dim A, i
  34.     Application.DisplayAlerts = False
  35.     With ActiveSheet
  36.         .Range("B:B,D:D").Delete Shift:=xlToLeft
  37.         With .Range("B:C")
  38.             .Replace Chr(32) & Chr(13), "", xlPart          '清除不可見字元
  39.             .Replace Chr(41) & Chr(13), ")"                 '清除不可見字元
  40.             .Replace "$", ""
  41.             .Replace ",", ""
  42.             .NumberFormatLocal = "#,##0_);[紅色](#,##0)"
  43.             .HorizontalAlignment = xlRight
  44.             .VerticalAlignment = xlCenter
  45.         End With
  46.         With .Range("A2:C2,A3:C3,A4:C4,A5:C5")
  47.             .HorizontalAlignment = xlCenter
  48.             .VerticalAlignment = xlCenter
  49.             .WrapText = False
  50.             .Merge
  51.             .Areas(4).HorizontalAlignment = xlRight
  52.         End With
  53.         .[A6:A7].Insert Shift:=xlToRight
  54.         i = 8
  55.         Do While .Cells(i, 1) <> ""
  56.             If InStr(.Cells(i, 1), String(2, Mid(.Cells(i, 1), 1, 1))) Then
  57.                 .Cells(i, 1).Resize(, 3).Merge
  58.                 .Cells(i, 1).Resize(, 3).HorizontalAlignment = xlCenter
  59.             ElseIf Len(.Cells(i, 1)) >= 15 Then
  60.                 .Cells(i, 1).WrapText = True
  61.             End If
  62.             i = i + 1
  63.         Loop
  64.         Range("A:A").ColumnWidth = 40
  65.         .Range("B:C").EntireColumn.AutoFit
  66.     End With
  67.     Application.DisplayAlerts = True
  68. End Sub
複製代碼

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2015-5-19 09:42 | 顯示全部帖子
回復 10# fei6999

試試看
  1. Option Explicit
  2. Sub 個別現金流量表()
  3.     Dim Sh As Worksheet
  4.     With CreateObject("InternetExplorer.Application")
  5.         .Navigate "http://mops.twse.com.tw/mops/web/t164sb05"
  6.         .Visible = True
  7.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  8.         With .Document
  9.             .getElementsByTagName("input")(38).Value = "5349"  '這裡修改 股票代號
  10.             .getElementsByTagName("input")(41).Click
  11.         End With
  12.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  13.       
  14.       '******************************
  15.        .Document.body.innerHTML = .Document.getElementsByTagName("table")(3).outerHTML
  16.         .ExecWB 17, 2       '  Select All
  17.         .ExecWB 12, 2       '  Copy selection
  18.         .Quit
  19.         End With
  20.         '****************************
  21.         Set Sh = Sheets(1)
  22.         Sh.UsedRange.Clear
  23.         With Sheets.Add(, Sheets(Sheets.Count))
  24.             .Range("A1").Select
  25.             .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
  26.             .Range("C:D,P:P").Copy Sh.[A1]
  27.             Application.DisplayAlerts = False
  28.             .Delete
  29.             Application.DisplayAlerts = True
  30.         End With
  31.         With Sh
  32.             .Activate
  33.             .Rows("1:11").Delete
  34.             .UsedRange.EntireColumn.AutoFit
  35.         End With
  36.       
  37. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 稻穗結得越飽滿，越會往下垂，一個人越有成就，就要越有謙沖的胸襟。
返回列表 上一主題