VBA获取股票历史数据方法

Sub 股票历史记录查询()
Worksheets("历史记录表").Cells.Clear  ''输出结果表
X = Application.CountA(Worksheets("代码").Range("A:A"))  ''需要提取的股票代码
Y = 1

For i = 2 To X 

   dm = IIf(Worksheets("代码").Cells(i, 1) < 600000, "1", "0") & Worksheets("代码").Cells(i, 1)  ‘’‘分上证
   dm = "http://quotes.money.163.com/service/chddata.html?code=" & dm    ’‘’‘本次以163网站为试验
   
    With Worksheets("历史记录表").QueryTables.Add(Connection:="URL;" & dm, Destination:=Worksheets("历史记录表").Range("A" & Y))
    .RefreshStyle = xlOverwriteCells  ’‘’有三种，0：不插入行或列写入，1：插入部分列，2：插入列
    
     'With ActiveSheet.QueryTables.Add(Connection:="URL;" & wy, Destination:=[a2])
         .Refresh
    End With
 
   Y = Application.CountA(Worksheets("历史记录表").Range("A:A"))
   Next
 

 Y = Application.CountA(Worksheets("历史记录表").Range("A:A"))

 Worksheets("历史记录表").Range("A1:A" & Y).TextToColumns Worksheets("历史记录表").[A1], 1, , , , , 1 ‘’‘分列

 Worksheets("历史记录表").[A:A].Columns.AutoFit
  

MsgBox ("OK")
End Sub

RefreshStyle 取值如下：
會指定在指定之工作表上加入或刪除列的方式，以容納查詢所傳回的記錄集中的列數。
名稱 值 描述
xlinsertdeletecells: 1 插入或者刪除部分的列以符合新記錄集所需要的確實列數。
xlInsertEntireRows 2 在必要時插入完整的數列以容納任何溢位。 不會從工作表刪除任何儲存格或列。
xlOverwriteCells 0 不在工作表中加入任何新儲存格或列。 覆寫周圍儲存格中的資料以容納溢位。

结果如下：