返回列表 上一主題 發帖

VBA 下載交易所資料ETF前面的00會自動不見，要如何修正

frogfrer

帖子
2 
主題
1 
精華
0 
積分
52 
點名
79  
作業系統
XP 
軟體版本
OFFICE 2003 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2012-8-8 
最後登錄
2024-11-26 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2019-8-3 17:58 | 只看該作者

VBA 下載交易所資料ETF前面的00會自動不見，要如何修正

VBA 下載交易所資料ETF前面的00會自動不見，要如何修正
我要完整證券代號有出現
如：［0050］ ［元大台灣50］會變成［50］  ［元大台灣50］


程式碼如下
Sub test()

    Dim strGetDate As String    '宣告日期
    strGetDate = Format(Range("b1").Value, "YYYYMMDD")  '格式化日期
   
   
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;https://www.twse.com.tw/exchangeReport/TWTB4U?response=html&date=20190805&selectType=All" _
        , Destination:=Range("$A$4"))
        .Refresh BackgroundQuery:=False
         .Delete
    End With
   
End Sub
收藏 分享

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2020-4-24 16:01 | 只看該作者
本帖最後由 GBKEE 於 2020-4-24 19:40 編輯

回復 1# frogfrer
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Ar, R As Double, C As Integer, Ttitle As String, S As String
  4.     With New InternetExplorer  '引用項目加入  Microsoft Internet Controls
  5.             .Navigate "https://www.twse.com.tw/exchangeReport/TWTB4U?response=html&date=20200424&selectType=All"
  6.             .Visible = True
  7.             Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  8.             With .Document.all.TAGS("TABLE")(0)
  9.                 Ttitle = .Rows(0).innerText
  10.                 ReDim Ar(1 To .Rows.Length - 1, .Rows(1).Cells.Length - 1)
  11.                 For R = 1 To .Rows.Length - 1
  12.                     For C = 0 To .Rows(R).Cells.Length - 1
  13.          
  14.                         Ar(R, C) = IIf(C = 0 And Mid(.Rows(R).Cells(C).innerText, 1, 1) = 0, "'", "") & .Rows(R).Cells(C).innerText
  15.                         'IIf(C = 0 And Mid(.Rows(R).Cells(C).innerText, 1, 1) = 0, "'", "")  '**證券代號0開頭加上'轉為文字
  16.                     Next
  17.                 Next
  18.             End With
  19.             .Quit
  20.     End With
  21.     With ActiveSheet   '可更改工作表
  22.         .UsedRange.Clear
  23.         .[a1] = Ttitle
  24.         .[a2].Resize(UBound(Ar), 3) = Ar
  25.     End With
  26. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

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