背景

Question

背景

免责声明：我是一个初学者，请提供我的-最合理的错误-代码。

我想使用启用按钮的VBA宏更新货币对的值（ PREV CLOSE ）。我的Excel工作表在 G：G 列中包含FX对（例如USDGBP），然后用于对列中的每个对运行FOR循环。

然后，该值将存储在 I：I 列中

现在，调试器的问题在于我将在下面突出显示的一行代码

来源

我从https://www.youtube.com/watch?v=JxmRjh-S2Ms&t=1050s中得到了一些启发-特别是从17:34开始-但我希望我的代码在按一下按钮时就可以在多个网站上使用。

我尝试了以下代码

InlineValidator<Task>

预期结果

当我在 G：G 列的单元格上输入“ USDGBP”时，宏将转到https://www.bloomberg.com/quote/EURGBP:CUR，并“抓住” PREV CLOSE值0.8732（使用今天的值）并将其插入列I：I

的相应行中

到目前为止，我只是在面对调试器时，对如何解决该问题并不了解。

Answer 1

您可以循环使用类选择器。模式

.previousclosingpriceonetradingdayago .value__b93f12ea

指定获取类value__b93f12ea的子元素和父类previousclosingpriceonetradingdayago的父元素。 “。”前面是css class selector，因为现代浏览器针对css进行了优化，所以是一种更快的选择方式。两个类之间的间隔为descendant combinator。 querySelector从网页html文档返回此模式的第一个匹配项。

此页面匹配：

您可以在此处再次查看父子关系和班级：

<section class="dataBox previousclosingpriceonetradingdayago numeric">
    <header class="title__49417cb9"><span>Prev Close</span></header>
    <div class="value__b93f12ea">0.8732</div>
</section>

如果您是彭博客户，请查看其APIs。此外，您很有可能可以从其他专用API获取相同的信息，从而可以更快，更可靠地请求xhr。

VBA（Internet Explorer）：

Option Explicit
Public Sub test()
    Dim pairs(), ws As Worksheet, i As Long, ie As Object
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set ie = CreateObject("InternetExplorer.Application")
    With ws
        pairs = Application.Transpose(.Range("G2:G" & .Cells(.rows.Count, "G").End(xlUp).Row).Value) ' assumes pairs start in row 2
    End With
    Dim results()
    ReDim results(1 To UBound(pairs))
    With ie
        .Visible = True
        For i = LBound(pairs) To UBound(pairs)
            .Navigate2 "https://www.bloomberg.com/quote/" & pairs(i) & ":CUR", False
             While .Busy Or .readyState < 4: DoEvents: Wend
             results(i) = .document.querySelector(".previousclosingpriceonetradingdayago .value__b93f12ea").innerText
        Next
        .Quit
    End With
    ws.Cells(2, "I").Resize(UBound(results), 1) = Application.Transpose(results)
End Sub

对于数量非常有限的请求（导致阻塞），您可以使用xhr request并用正则表达式将该值输出。我假设成对出现在第一张纸中，从G2开始。我还假设在G列中（直到要搜索的包括最后一对）没有空单元格或无效对。否则，您将需要开发代码来处理此问题。

尝试正则表达式here

Option Explicit
Public Sub test()
    Dim re As Object, pairs(), ws As Worksheet, i As Long, s As String
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set re = CreateObject("VBScript.RegExp")
    With ws
        pairs = Application.Transpose(.Range("G2:G" & .Cells(.rows.Count, "G").End(xlUp).Row).Value) ' assumes pairs start in row 2
    End With
    Dim results()
    ReDim results(1 To UBound(pairs))
    With CreateObject("MSXML2.XMLHTTP")
        For i = LBound(pairs) To UBound(pairs)
            .Open "GET", "https://www.bloomberg.com/quote/" & pairs(i) & ":CUR", False
            .send
            s = .responseText
            results(i) = GetCloseValue(re, s, "previousClosingPriceOneTradingDayAgo%22%3A(.*?)%2")
        Next
    End With
    ws.Cells(2, "I").Resize(UBound(results), 1) = Application.Transpose(results)
End Sub
Public Function GetCloseValue(ByVal re As Object, inputString As String, ByVal pattern As String) As String 'https://regex101.com/r/OAyq30/1
    With re
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .pattern = pattern
        If .test(inputString) Then
            GetCloseValue = .Execute(inputString)(0).SubMatches(0)
        Else
            GetCloseValue = "Not found"
        End If
    End With
End Function

Answer 2

尝试以下代码：但在确保添加2个参考之前，请转到“工具”>“参考”>然后查找Microsoft HTML对象库和Microsoft Internet控件

此代码在使用您的示例时有效。

Sub getPrevCloseValue()

Dim ie As Object

Dim mySh As Worksheet
Set mySh = ThisWorkbook.Sheets("Sheet1")

Dim colG_Value As String
Dim prev_value As String


For a = 3 To mySh.Range("G" & Rows.Count).End(xlUp).Row
    colG_Value = mySh.Range("G" & a).Value

    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True
    ie.navigate "https://www.bloomberg.com/quote/" & colG_Value & ":CUR"
    Do While ie.Busy: DoEvents: Loop
    Do Until ie.readyState = 4: DoEvents: Loop
    'Application.Wait (Now + TimeValue("00:00:03")) 'activate if having problem with delay

    For Each sect In ie.document.getElementsByTagName("section")
        If sect.className = "dataBox previousclosingpriceonetradingdayago numeric" Then
            prev_value = sect.getElementsByTagName("div")(0).innerText
            mySh.Range("I" & a).Value = prev_value
            Exit For
        End If
    Next sect

Next a

我有一个使用vba进行基本Web自动化的视频教程，其中包括Web数据抓取和其他命令，请检查以下链接： https://www.youtube.com/watch?v=jejwXID4OH4&t=700s

如何使用VBA从Bloomberg网站上抓取数据

背景

来源

我尝试了以下代码

预期结果

2 个答案: