Board logo

標題: 有辦法使用vba匯入外部web資料嗎？ [打印本頁]
作者: gkld    時間: 2013-1-2 22:41     標題: 有辦法使用vba匯入外部web資料嗎？

請問各位高人
有法子使用vba匯入外部web資料，如圖 紅色框框的現金流量表
[attach]13765[/attach]
我怎麼用excel的匯入功能都辦不到
請指導，謝謝
作者: freeffly    時間: 2013-1-3 16:59

回復 1# gkld


    據我所知公開資訊站的內容要用比較特殊語法去抓
   這各我也不會
   你貼的那個表應該不是能匯入的格式
   建議你找其他網站代替
作者: gkld    時間: 2013-1-3 20:04

回復 2# freeffly
原來是這樣呀!!
弄了半天，是格式的問題~
感謝回答告知
我再去找其它網站資料代替了
作者: GBKEE    時間: 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
複製代碼
作者: gkld    時間: 2013-1-27 21:37

回復 4# GBKEE
感謝板大熱心回貼
我現在才看到這篇文章，真不好意思呀
後來我已用別的網站資料代替了，也成功解絕了問題
作者: freeffly    時間: 2013-1-28 08:56

回復 4# GBKEE


    版主的方式可以執行
   跟一般匯入WEB查詢的方式不依樣
   請問如果要查指定的季報要如何改?
作者: yuch8663    時間: 2013-2-2 17:29

[attach]14129[/attach][attach]14129[/attach][attach]14128[/attach]請教GBKEE大大，我修改成迴圈會出現  沒有設定物件變數或with 區塊變數  的錯誤訊息，何解?
作者: yuch8663    時間: 2013-2-2 17:31

[attach]14129[/attach]
請教GBKEE大大，我修改成迴圈會出現  沒有設定物件變數或with 區塊變數  的錯誤訊息，何解?
作者: fei6999    時間: 2015-5-17 10:19

想請教這是這是現金流量表的網頁
http://mops.twse.com.tw/mops/web/t164sb05
透過上述程序抓取後在excel表上字串無法呈現表格,請問要如何修改
A = Split(.Document.getelementsbytagname("table")(16).innertext, vbLf)'這行我16改3
A = Split(.Document.getelementsbytagname("table")(3).innertext, vbLf)

Option Explicit
Sub 個別現金流量表()
    Dim i, r As Integer, A As Variant, AA As Variant
    With CreateObject("InternetExplorer.Application")
        .Navigate "http://mops.twse.com.tw/mops/web/t164sb05"
        .Visible = True
        Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
        With .Document
            .getelementsbytagname("input")(38).Value = "5349"  '這裡修改 股票代號
            .getelementsbytagname("input")(41).Click
        End With
        Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
      
      '******************************
        r = 1
        Cells.Clear
        A = Split(.Document.getelementsbytagname("table")(3).innertext, vbLf)
        For i = 0 To UBound(A)
                AA = Trim(A(i))
                Do While InStr(AA, Space(5))
                    AA = Replace(AA, Space(5), Space(4))
                Loop
                AA = Split(AA, Space(2))
                Cells(r, 1).Resize(, UBound(AA) + 1) = AA
                r = r + 1
        Next
       .Quit
        End With
    '******************************
     資料整理
End Sub
Private Sub 資料整理()
    Dim A, i
    Application.DisplayAlerts = False
    With ActiveSheet
        .Range("B:B,D").Delete Shift:=xlToLeft
        With .Range("B:C")
            .Replace Chr(32) & Chr(13), "", xlPart          '清除不可見字元
            .Replace Chr(41) & Chr(13), ")"                 '清除不可見字元
            .Replace "$", ""
            .Replace ",", ""
            .NumberFormatLocal = "#,##0_);[紅色](#,##0)"
            .HorizontalAlignment = xlRight
            .VerticalAlignment = xlCenter
        End With
        With .Range("A2:C2,A3:C3,A4:C4,A5:C5")
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Merge
            .Areas(4).HorizontalAlignment = xlRight
        End With
        .[A6:A7].Insert Shift:=xlToRight
        i = 8
        Do While .Cells(i, 1) <> ""
            If InStr(.Cells(i, 1), String(2, Mid(.Cells(i, 1), 1, 1))) Then
                .Cells(i, 1).Resize(, 3).Merge
                .Cells(i, 1).Resize(, 3).HorizontalAlignment = xlCenter
            ElseIf Len(.Cells(i, 1)) >= 15 Then
                .Cells(i, 1).WrapText = True
            End If
            i = i + 1
        Loop
        Range("A:A").ColumnWidth = 40
        .Range("B:C").EntireColumn.AutoFit
    End With
    Application.DisplayAlerts = True
End Sub
作者: fei6999    時間: 2015-5-17 22:19

從網頁讀取的字串都連在一塊如下:
"未實現外幣兌換損失（利益）104,374-16,320"
請問如何在回傳資料時按表單位置定位
作者: GBKEE    時間: 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
複製代碼




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