Как улучшить очистку данных с помощью VBA?

Question

У меня есть код ниже, который извлекает данные из интранета.Но для извлечения данных требуется больше времени. Кто-то может помочь мне изменить код для повышения производительности.Заранее спасибо

Примечание. Я не разместил URL-адрес, поскольку он является веб-сайтом клиента.Извините за это.

Sub FetchData() 
Dim IE As Object
Dim Doc As HTMLDocument
Dim myStr As String
On Error Resume Next

  Set IE = CreateObject("InternetExplorer.Application") 'SetBrowser
  IE.Visible = False

IE.navigate "URL" 'Open website
Do While IE.Busy Or IE.ReadyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop

Set Doc = IE.Document

Doc.getElementById("tbxUserID").Value = InputBox("Please Enter Your ID")
Doc.getElementById("txtPassword").Value = InputBox("Please Enter Your                     
Password")
Doc.getElementById("BtnLogin").Click
Do While IE.Busy Or IE.ReadyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop

IE.navigate "URL"
Do While IE.Busy Or IE.ReadyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop

Dim LastRow As Long

Set wks = ActiveSheet
LastRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row
Set rowNo = wks.Range("A1:A" & LastRow)
  For rowNo = 2 To LastRow
Doc.getElementById("txtField1").Value =         
ThisWorkbook.Sheets("Sheet1").Range("A" & rowNo).Value
Doc.getElementById("CtrlQuickSearch1_imgBtnSumbit").Click
Do While IE.Busy Or IE.ReadyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop

strVal1 = Doc.querySelectorAll("span")(33).innerText
ThisWorkbook.Sheets("Sheet1").Range("B" & rowNo).Value = strVal1
strVal2 = Doc.querySelectorAll("span")(35).innerText
ThisWorkbook.Sheets("Sheet1").Range("C" & rowNo).Value = strVal2

Next

End Sub 

Answer 1

Не могу гарантировать, что это будет работать.Примечания:

1. Использование Worksheets collection
2. Использование Option Explicit - это означает, что вам придется использовать правильный тип данных повсюду.В настоящее время у вас есть необъявленные переменные, и, например, rowNo используется как Long и как диапазон.
3. Удаление On Error Resume Next
4. Помещение всех рабочих таблиц в переменные
5. Размещение значений в массиве и циклическом массиве для получения значений идентификатора.Лист циклических операций стоит дорого
6. Использование раннего связывания и добавления класса в InternetExplorer
7. Предположение, что после входа в систему появляется новый URL-адрес и вам нужно переходить к этому перед каждым новым значением цикла
8. Удаление венгерской нотации
9. Идентификаторы являются самым быстрым методом выбора, поэтому улучшения там нет
10. С вашими селекторами типа css, например, .document.querySelectorAll("span")(33), вы можете узнать, есть ли у одного узла короткий селекторкоторые можно использовать, вместо использования nodeList

VBA:

Option Explicit  
Public Sub FetchData()
    Dim ie As Object, ie As InternetExplorer
    Dim lastRow As Long, wks As Worksheet, i As Long, ws As Worksheet

    Set ie = New SHDocVw.InternetExplorer        'SetBrowser
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set wks = ActiveSheet                        '<==use explicit sheet name if possible
    lastRow = wks.Cells(wks.rows.Count, "A").End(xlUp).Row
    loopvalues = Application.Transpose(wks.Range("A2:A" & lastRow).Value)

    With ie

        .Visible = False
        .Navigate2 "URL"                         'Open website

        While .Busy Or .readyState < 4: DoEvents: Wend

        .document.getElementById("tbxUserID").Value = InputBox("Please Enter Your ID")
        .document.getElementById("txtPassword").Value = InputBox("Please Enter Your Password")
        .document.getElementById("BtnLogin").Click

        While .Busy Or ie.readyState < 4: DoEvents: Wend

        Dim newURL As String, val1 As String, val2 As String
        newURL = .document.URL

        For i = LBound(loopvalues) To UBound(loopvalues)

            .document.getElementById("txtField1").Value = loopvalues(i)
            .document.getElementById("CtrlQuickSearch1_imgBtnSumbit").Click

            While .Busy Or .readyState < 4: DoEvents: Wend

            val1 = .document.querySelectorAll("span")(33).innerText
            ws.Range("B" & i).Value = val1
            val2 = .document.querySelectorAll("span")(35).innerText
            ws.Range("C" & i).Value = val2

            .Navigate2 newURL

            While .Busy Or ie.readyState < 4: DoEvents: Wend
        Next
        .Quit
    End With
End Sub