Отказ от ответственности: я новичок, пожалуйста, представьте мой - наиболее правдоподобный - код.
Я хочу обновить значение валютных пар ( PREV CLOSE ) с помощью макроса VBA с включенной кнопкой. Моя таблица Excel содержит пары FX (например, USDGBP) в столбце G: G, которые затем используются для запуска цикла FOR для каждой пары в столбце.
Значение будет сохранено в столбце I: I
Прямо сейчас проблема отладчика заключается в одной строке кода, которую я выделю ниже.
Я черпал вдохновение из https://www.youtube.com/watch?v=JxmRjh-S2Ms&t=1050s - в частности, 17:34 и далее - но я хочу, чтобы мой код работал на нескольких веб-сайтах одним нажатием кнопки.
Public Sub Auto_FX_update_BMG()
Application.ScreenUpdating = False 'My computer is not very fast, thus I use this line of
'code to save some computing power and time
Dim internet_object As InternetExplorer
Dim i As Integer
For i = 3 To Sheets(1).Cells(3, 7).End(xlDown).Row
FX_Pair = Sheets(1).Cells(i, 7)
Set internet_object = New InternetExplorer
internet_object.Visible = True
internet_object.navigate "https://www.bloomberg.com/quote/" & FX_Pair & ":CUR"
Application.Wait Now + TimeValue("00:00:05")
internet_object.document.getElementsByClassName("class")(0).getElementsByTagName ("value__b93f12ea") '--> DEBUGGER PROBLEM
'My goal here is to "grab" the PREV CLOSE
'value from the website
With ActiveSheet
.Range(Cells(i, 9)).Value = HTML_element.Children(0).textContent
End With
Sheets(1).Range(Cells(i, 9)).Copy 'Not sure if these 2 lines are unnecesary
ActiveSheet.Paste
Next i
Application.ScreenUpdating = True
End Sub
Когда я введу «USDGBP» в ячейку столбца G: G , макрос перейдет на https://www.bloomberg.com/quote/EURGBP:CUR и «захватит» значение PREV CLOSE, равное 0,8732 (используя сегодняшнее значение) и вставьте его в соответствующий ряд столбца I: I
На данный момент я сталкиваюсь с отладчиком без особого представления о том, как решить эту проблему.
Всего 2 ответа
Вы можете использовать селекторы классов в цикле. Шаблон
.previousclosingpriceonetradingdayago .value__b93f12ea
указывает на получение дочерних элементов с классом value__b93f12ea
имеющих родителя с классом previousclosingpriceonetradingdayago
. "." впереди находится селектор класса css , и это более быстрый способ выбора, так как современные браузеры оптимизированы для css. Пространство между двумя классами является потомком комбинатора . querySelector возвращает первое совпадение для этого шаблона из HTML-документа веб-страницы.
Это соответствует на странице:
Вы можете увидеть родительские дочерние отношения и классы снова здесь:
<section class="dataBox previousclosingpriceonetradingdayago numeric"> <header class="title__49417cb9"><span>Prev Close</span></header> <div class="value__b93f12ea">0.8732</div> </section>
NB. Если вы являетесь клиентом Bloomberg, изучите его API . Кроме того, весьма вероятно, что вы можете получить эту же информацию из других выделенных 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 и вывести значение заново. Я предполагаю, что пары находятся на листе один и начинаются с G2. Я также предполагаю, что в столбце G нет пустых ячеек или недопустимых пар, включая последнюю пару для поиска. В противном случае вам нужно будет разработать код, чтобы справиться с этим.
Попробуйте регулярное выражение здесь
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
Попробуйте следующий код: Но перед тем, как добавить 2 ссылки, перейдите в Инструменты> Ссылки>, затем найдите Microsoft HTML Object Library и Microsoft Internet Controls.
Этот код работает при использовании вашего примера.
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, который включает в себя очистку веб-данных и другие команды, перейдите по ссылке ниже: https://www.youtube.com/watch?v=jejwXID4OH4&t=700s