这是一个可以方便地获取当前外汇汇率的 VBA 函数,通过爬取网站上的外汇汇率获得。你可以直接在 Excel 单元格中插入短代码【=GetExchangeRate(“待转化币种符号”,”转化为币种符号”)】轻松获取当前外汇汇率,比如 =GetExchangeRate(“USD”,”CNY”) 。也可以在 VBA 代码中直接调用该函数获取当前汇率,比如 Call GetExchangeRate(“USD”,”CNY”)

效果的话可能不太方便演示,这里直接给出代码,大家有需要的试一下把。

' 获取当前汇率
Function GetExchangeRate(ex As String, cur As String)

    '参数为空时,默认返回美元对人民币的汇率
    If ex = "" Then ex = "USD" Else ex = ex
    If cur = "" Then cur = "CNY" Else cur = cur
    ' 定义变量
    Dim URL, oHttp, responseText, result, exchangeRate As String
    ' 爬取网站数据
    URL = "https://qq.ip138.com/hl.asp?from=" & ex & "&to=" & cur & "&q=100"
    Set oHttp = CreateObject("MSXML2.XMLHTTP")
    With oHttp
        .Open "GET", URL, False
        .send
        responseText = .responseText
    End With
    ' 截取当前汇率
    result = Split(Split(Split(responseText, "<p>按当前汇率兑换结果</p>")(1), "<td>")(5), "p>")(1)
    exchangeRate = Left(result, 8)
    
    GetExchangeRate = exchangeRate
             
End Function

以上。