Нажмите все галочки на сайте

Question

У меня есть (в Excel, VBA) суб, который будет перемещаться на этой странице:

http://www.nordea.dk/wemapp/currency/dk/valutaKurser

И скопировать процитированные ставки. Однако я хотел бы удалить все ставки и добавить только те, которые мне нужны.

Для этого мне нужно проверить все поля (слева в таблице), но количество ячеек не является постоянным - поэтому я не могу перекодировать имена файлов.

Я полагаю, что одним из способов этого является извлечение всего html, определение количества строк, а затем цикл. Но это кажется очень неудобным. Разумеется, есть какой-то более легкий способ, который требует меньше кода и меньше памяти?

Answer 1

Вы можете Split() таблицу по vbNewLine и поиск валюты в каждой строке набора (виду заголовки).
Поскольку входы названы так: таблица: body: rows: 2: cells: 1: cell: check Вы можете совместить валюту с помощью флажка.
На практике это выглядит (до получения имен элементов):

Function FirstRow(myArray() As String, Optional curr As String) As Long 
If curr = "" Then 
    curr = "*[A-Z][A-Z][A-Z]/[A-Z][A-Z][A-Z]*" 
Else 
    curr = "*" & curr & "*" 
End If 

For i = LBound(myArray) To UBound(myArray) 
    If myArray(i) Like curr Then 'FX denoted as "XXX/XXX" 
     FirstRow = i 
     Exit Function 
    End If 
Next i 
End Function 
Sub ert() 
Dim myArray() As String, URLStr As String 
URLStr = "http://www.nordea.dk/wemapp/currency/dk/valutaKurser" 

Set ie = CreateObject("InternetExplorer.Application") 
ie.Visible = False 
ie.Navigate URLStr 

Do Until (ie.readyState = 4 And Not ie.Busy) 
    DoEvents 
Loop 

On Error GoTo Err: 
Data = ie.Document.body.innerHTML 'innerText 

If False Then 
Err: 
    Data = ie.Document.body.innerHTML 
End If 

myArray = Split(Data, "<tr>") 'vbNewLine) 'vbCrLf) 

'For i = LBound(myArray) To UBound(myArray) 
' Cells(i + 1, 1).Value2 = myArray(i) 
'Next 

Dim curr() As String 
ReDim curr(2) 
    curr(0) = "DKK/NOK" 
    curr(1) = "EUR/SEK" 
    curr(2) = "USD/CHF" 
For i = LBound(curr) To UBound(curr) 
    x = FirstRow(myArray, curr(i)) - FirstRow(myArray) + 1 
    MsgBox "table:body:rows:" & x & ":cells:1:cell:check" 
Next i 
ie.Quit 
Set ie = Nothing 
End Sub 

Я пардон, vbNewLine не будет резать его на этот раз, мой плохой. Кроме того, проверка именованного элемента не должна быть такой сложной, если бы вы предоставили свой snipplet для проверки всех ящиков, которые я бы даже дал ему.