求助老师修改一下代码

Mooge88

抓取网页上的期货历史数据后变成横向排列了，请老师帮忙修改一下代码变成竖向对齐排列。


Sub 原油历史交易数据()
    [2:7000].ClearContents
   For n = 1 To 2
    yzc = "http://vip.stock.finance.sina.com.cn/q/view/vFutures_History.php?page=" & n & "&breed=CL&start=2000-01-01&end=2018-08-16&jys=NYME&pz=CL&hy=&type=global&name=NYMEX原油"
    Set myQuery = ActiveSheet.QueryTables.Add(Connection:="URL;" & yzc, Destination:=[a2])
    myQuery.Refresh 0
    [a:a].Replace "None", ""
   ' Range("a2:a7000").TextToColumns [a2], 1, , , , , 1
    Range("A3").Select
    Selection.Columns.AutoFit
    Debug.Print yzc
    Next n
    Rows("3:31").Delete Shift:=xlUp
    Range("A2") = "NYMEX原油(CL)历史交易数据"
End Sub

Mooge88

增加传附件

xiangbaoan

Sub 交易数据()
Dim html, tb, url$, tp(), c%, r&, n%, i%, j%
[a:f] = ""
Application.ScreenUpdating = False
Set html = CreateObject("htmlfile")
r = 1
For n = 1 To 2
    url = "http://vip.stock.finance.sina.com.cn/q/view/vFutures_History.php?page=" & n & "&breed=CL&start=2000-01-01&end=2018-08-16&jys=NYME&pz=CL&hy=&type=global&name=NYMEX原油"
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", url, False
        .send "text/html; charset=GB2312"
        html.body.innerhtml = StrConv(.responsebody, vbUnicode)
    End With
    Set tb = html.all.tags("table")(3).Rows
    ReDim  tp(41, 5)
    For i = 1 To tb.Length - 1
        For j = 0 To tb(i).Cells.Length - 1
            tp(i, j) = tb(i).Cells(j).innertext
        Next
    Next
    With ActiveSheet
        .Cells(r, 1).Resize(42, 6) = tp
        r = .[a65536].End(3).Row + 1
    End With
Next
Set html = Nothing: Set tb = Nothing
Application.ScreenUpdating = True
End Sub