VBA宏用于下一个循环

时间:2017-12-12 03:48:41

标签: excel vba excel-vba

我是编码的菜鸟。我得到了帮助,创建了以下代码。但是,我需要创建一个for和next循环。基本上,URL =表格(“Sheet2”)。范围(A:A)

每个循环都需要更改URL。该URL将从A1列出,然后列为某些A(X)。

我听说很容易做到,但我花了几个小时试图学习它并超越我的技能......

Sub Test7()
    'Haluk
    '11/12/2017
    
    Dim objHTTP As Object
    Dim MyScript As Object
    Dim myData As Variant
    Dim myLength As Byte
    
    'Clean the sheet
    
    ActiveSheet.Cells.Clear

    URL = "https://min-api.cryptocompare.com/data/histominute?fsym=BTC&tsym=USD&limit=60&aggregate=3&e=CCCAGG"
    
    'The returned JSon table contents have the primary key/label named as "Data"
    'We are going to refer this "Data" in the following two JScripts "getValue" and "getLength"
    
    Set MyScript = CreateObject("MSScriptControl.ScriptControl")
    MyScript.Language = "JScript"
    MyScript.AddCode "function getValue(JSonList, JItem, JSonProperty) { return JSonList.Data[JItem][JSonProperty]; }"
    MyScript.AddCode "function getLength(JSonList) { return JSonList.Data.length; }"
    
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    objHTTP.Open "GET", URL, False
    objHTTP.Send
    
    'Get the JSon table
    
    Set RetVal = MyScript.Eval("(" & objHTTP.responseText & ")")
    objHTTP.abort
    
    'Retrieve the value of the key "close" in the 4th item of the data set "Data"
    'with the help of the JScript function "getValue" above
    
    myData = MyScript.Run("getValue", RetVal, 4, "close")
    MsgBox "This is a small demo...." & vbCrLf & vbCrLf _
    & "Value of the key 'close' of the 4th data in the JSON table is: " & myData
    
    'Get the count of items in the JSon table under "Data"
    
    myLength = MyScript.Run("getLength", RetVal)
    
    'Write labels of the key in the table to the sheet
    
    Range("B1") = "time"
    Range("C1") = "close"
    Range("D1") = "high"
    Range("E1") = "low"
    Range("F1") = "open"
    Range("G1") = "volumefrom"
    Range("H1") = "volumeto"
    Range("J1") = "TimeFrom:"
    Range("J2") = "TimeTo:"
    Range("B1:H1, J1:J2").Font.Bold = True
    Range("B1:H1, J1:J2").Font.Color = vbRed
    
    'Get all the values of the JSon table under "Data"
    
    For i = 0 To myLength - 1
        Range("A" & i + 2) = "Data -" & i
        Range("B" & i + 2) = MyScript.Run("getValue", RetVal, i, "time") / (CDbl(60) * CDbl(60) * CDbl(24)) + #1/1/1970#
        Range("C" & i + 2) = MyScript.Run("getValue", RetVal, i, "close")
        Range("D" & i + 2) = MyScript.Run("getValue", RetVal, i, "high")
        Range("E" & i + 2) = MyScript.Run("getValue", RetVal, i, "low")
        Range("F" & i + 2) = MyScript.Run("getValue", RetVal, i, "open")
        Range("G" & i + 2) = MyScript.Run("getValue", RetVal, i, "volumefrom")
        Range("H" & i + 2) = MyScript.Run("getValue", RetVal, i, "volumeto")
    Next
    
    'Get the time info given in the JSon table
    
    Range("K1") = RetVal.TimeFrom / (CDbl(60) * CDbl(60) * CDbl(24)) + #1/1/1970#
    Range("K2") = RetVal.TimeTo / (CDbl(60) * CDbl(60) * CDbl(24)) + #1/1/1970#
    
    Set objHTTP = Nothing
    Set MyScript = Nothing
End Sub

1 个答案:

答案 0 :(得分:1)

将除了这些行之外的所有内容放在循环

Dim objHTTP As Object
    Dim MyScript As Object
    Dim myData As Variant
    Dim myLength As Byte

    'Clean the sheet

    ActiveSheet.Cells.Clear

for x = 1 to Application.Counta(Sheet2.Columns(1))
......代码的其余部分

将网址行更改为URL=Sheet2.Cells(x,1)

和范围到Sheet1.Range