Question

我有这个vba代码。我希望这个模块每隔一分钟刷新一次并更改单元格的值。

我尝试了Application.Volatile，但没有帮助。当我点击CTRL + ALT + F9它的工作。

谢谢。

Function CryptoQuote()
Dim strURL As String, strCSV As String
strURL = "https://min-api.cryptocompare.com/data/price?fsym=BTC&tsyms=USD"
Set http = CreateObject("msxml2.xmlhttp")
http.Open "GET", strURL, False
http.send
strCSV = http.responsetext
CryptoQuote = Val(onlydigits(strCSV))
Set http = Nothing

End Function


Function onlydigits(s As String) As String

Dim retval As String
Dim i As Integer
retval = ""
For i = 1 To Len(s)
If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Or Mid(s, i, 1) = "." Then
retval = retval + Mid(s, i, 1)
End If
Next
onlydigits = retval
End Function

Answer 1

使用为VBA提供的OnTime功能。（网上有很多信息）。例如：

Application.OnTime Now + TimeValue("00:01:00"), "my_Procedure"

每分钟运行一次代码。

Answer 2

我修改了你的代码，因为UDF不适合这个问题：

Option Explicit

Public Sub CryptoQuote()
    Debug.Print Now & " CryptoQuote called" ' In case the value does not change, we will know if it is because this Sub is not called again or because cryptocompare.com sent the same answer
    Dim strURL As String: strURL = "https://min-api.cryptocompare.com/data/price?fsym=BTC&tsyms=USD"
    Dim http As Object: Set http = CreateObject("msxml2.xmlhttp")
    http.Open "GET", strURL, False
    http.send
    Dim strCSV As String: strCSV = http.responsetext
    ThisWorkbook.Worksheets(1).Cells(1, 1).Value = Val(onlydigits(strCSV)) ' Change this to refer to the cell where you would like to see the value
    Application.OnTime DateAdd("s", 1, Now), "CryptoQuote"
End Sub

Function onlydigits(s As String) As String
    Dim retval As String: retval = ""
    Dim i As Integer: For i = 1 To Len(s)
        If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Or Mid(s, i, 1) = "." Then
            retval = retval + Mid(s, i, 1)
        End If
    Next
    onlydigits = retval
End Function

如果您运行一次CryptoQuote，它将持续更新该值。

要在打开工作簿后自动开始更新，请将其添加到ThisWorkbook模块（而不是Module1，通常是插入代码但在VBA屏幕左侧找到Microsoft Excel Objects / ThisWorkbook）：

Private Sub Workbook_Open()
    CryptoQuote
End Sub

每分钟VBA更新模块

2 个答案: