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

frogfrer

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

下載 (12.5 KB)

2019-8-3 17:57

程式碼如下
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

回復 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

複製代碼