How do I clean up objects in Excel vba?

问题

Public Sub D_Galoplar()
    Application.ScreenUpdating = False
    Dim Asay(1 To 250)
    Dim Jsay(1 To 100)
    For q = 2 To Sheets("Y").Columns("A:A").Find(What:="boş").Row - 1
        Asay(q - 1) = Sheets("Y").Range("A" & q)
    Next q
    For q = 2 To Sheets("Y").Columns("C:C").Find(What:="boş").Row - 1
        Jsay(q - 1) = Sheets("Y").Range("C" & q)
    Next q
For w = 1 To 250
    Cells.Delete Shift:=xlUp
    Range("A1").Select
    If Asay(w) < 1 Then Exit For

    Dim elem As Object, trow As Object
    Dim R&, C&, s$
    With New XMLHTTP60
        .Open "POST", "https://yenibeygir.com/at/getatdetaytab", False
        .setRequestHeader "content-type", "application/x-www-form-urlencoded; charset=UTF-8"
        .send "tab=galopTab&id=" & Asay(w)
        s = .responseText
    End With
    With New HTMLDocument
        .body.innerHTML = s
        For Each elem In .getElementsByClassName("at_Galoplar")(0).Rows
            For Each trow In elem.Cells
                C = C + 1: Cells(R + 1, C) = trow.innerText
            Next trow
            C = 0: R = R + 1
        Next elem
    End With

    Cells.UnMerge
    Range("A1").Select

    If Range("A1048576").End(xlUp).Row < 2 Then GoTo ATLA2

    Columns("A:A").Insert
    For i = 2 To Range("B1048576").End(xlUp).Row - 1
        Range("A" & i) = Asay(w)
    Next i

    Range("O2").FormulaR1C1 = "=IF(ISBLANK(RC[-9]),""-"",IF(ISNUMBER(RC[-9]),RC[-9]/4,((LEFT(RC[-9],1)*6000)+(MID(RC[-9],3,2)*100)+(RIGHT(RC[-9],1)*10))/400))"
    Range("P2").FormulaR1C1 = "=IF(ISBLANK(RC[-9]),""-"",IF(ISNUMBER(RC[-9]),RC[-9]/6,((LEFT(RC[-9],1)*6000)+(MID(RC[-9],3,2)*100)+(RIGHT(RC[-9],1)*10))/600))"
    Range("Q2").FormulaR1C1 = "=IF(ISBLANK(RC[-9]),""-"",IF(ISNUMBER(RC[-9]),RC[-9]/8,((LEFT(RC[-9],1)*6000)+(MID(RC[-9],3,2)*100)+(RIGHT(RC[-9],1)*10))/800))"
    Range("R2").FormulaR1C1 = "=IF(ISBLANK(RC[-9]),""-"",IF(ISNUMBER(RC[-9]),RC[-9]/10,((LEFT(RC[-9],1)*6000)+(MID(RC[-9],3,2)*100)+(RIGHT(RC[-9],1)*10))/1000))"
    Range("S2").FormulaR1C1 = "=IF(ISBLANK(RC[-9]),""-"",IF(ISNUMBER(RC[-9]),RC[-9]/12,((LEFT(RC[-9],1)*6000)+(MID(RC[-9],3,2)*100)+(RIGHT(RC[-9],1)*10))/1200))"
    Range("T2").FormulaR1C1 = "=IF(ISBLANK(RC[-9]),""-"",IF(ISNUMBER(RC[-9]),RC[-9]/14,((LEFT(RC[-9],1)*6000)+(MID(RC[-9],3,2)*100)+(RIGHT(RC[-9],1)*10))/1400))"
    Range("O2:T2").Copy
    Range("O2:O" & Range("A1048576").End(xlUp).Row).PasteSpecial Paste:=xlPasteFormulas
    Cells.Copy
    Cells.PasteSpecial Paste:=xlPasteValues
    Columns("O:T").Cut Columns("F:K")

    Range("A2:N" & Range("A1048576").End(xlUp).Row).Copy
    Sheets("Galop").Range("A" & Sheets("Galop").Range("A1048576").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues

ATLA2:
    Cells.Delete Shift:=xlUp
Next w
End Sub

I want to get a lot of data with the For Next cycle, but after a while the page hangs. How can I reset objects at the end of each cycle?

Asay numbers 10182 10221 10279 10303 10316 10325 10360 10370 10680 11598 11629 11715 11745 12335 12385 12533 12559 13154 13393 13635 13641 13669 13673 14027 14057 14062 14228 14619 14674 14687 14743 14770 14778 15197 15217 15323 15382 15507 15775 15828 16077 16335 16510 17149 17513 17867 18532 37964 60176 66067 66255 66581 66582 66896 66998 67056 67309 67356 67379 67473 68008 68012 68162 68298 68312 68320 68332 68333 68353 68383 68545 68702 68775 68922 69445 69606 69817 69963 69968 69985 69986 70048 70202 71372 (boş)

回答1:

Slowing down maybe due to throttling of network if you are trying to hit the site too many times in quick succession. This is particularly likely given your access method. Better would be to see if an API is available to bulk access info. You are likely going through many networks to get to this page as well. It may be possible to get some basic info about delays from TRACERT command from a command prompt.

You are doing a POST so remember there is a fair amount of server side stuff going on as well.

You don't need to set elem to Nothing as it only exists during your For Loop. Same for tRow.

Putting .getElementsByClassName("at_Galoplar")(0).Rows into a variable will provided faster referencing.

Write the results to an array first and then dump the array out to the sheet in one go will provide significant improvement in speed.

Using New keyword can lead to unexpected behaviour. You can create one instance of HTMLDocument and work with that provided you have good error handling in. I have had occassional cases in a loop where I have had to set HTMLDocument to Nothing before looping back round.

Personally, I would cheat and re-write this to leverage that you can issue GET requests to get the same info. I use a class to hold the XMLHTTP object, and an array to hold the results. I write the results out in one go. This takes a few seconds to run for me. The asay numbers are in Sheet1 range A1:A84.

Class module clsHTTP

Option Explicit    
Private http As Object

Private Sub Class_Initialize()
    Set http = CreateObject("MSXML2.XMLHTTP")
End Sub

Public Function GetString(ByVal url As String) As String
    Dim sResponse As String
    With http
        .Open "GET", url, False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        sResponse = StrConv(.responseBody, vbUnicode)
        GetString = sResponse
    End With
End Function

Standard module 1

Option Explicit
Public Sub DGaloplar()
    Dim asays(), ws As Worksheet, asay As Long, html As HTMLDocument
    Dim http As clsHTTP, url As String, headers(), numberOfRequests As Long

    headers = Array("Asay", "Tarih", "Sehir", "Kg", "Jokey", "400", "600", "800", "1000", "1200", "1400", "Ç", "Pist", "Durum")
    Set http = New clsHTTP
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set html = New HTMLDocument
    asays = Application.Transpose(ws.Range("A1:A84").Value) 'Load asay values from sheet 1

    Const numTableRows As Long = 11
    Const numTableColumns As Long = 15
    Const BASE_URL As String = "https://yenibeygir.com/at/getatdetaytab/?tab=galopTab&id="

    numberOfRequests = UBound(asays)

    Dim results(), headerRow As Boolean, tRows As Object, tRow As Object, iRow As Long
    Dim tCells As Object, tCell As Object, r As Long, c As Long, hTable As HTMLTable
    ReDim results(1 To numTableRows * numberOfRequests, 1 To numTableColumns)

    Application.ScreenUpdating = False

    For asay = 1 To numberOfRequests
        headerRow = True
        url = BASE_URL & asays(asay)
        html.body.innerHTML = http.GetString(url)
        Set hTable = html.querySelector(".at_Galoplar")
        Set tRows = hTable.getElementsByTagName("tr")

        For Each tRow In tRows
            If Not headerRow Then
                c = 2: r = r + 1
                results(r, 1) = asays(asay)
                Set tCells = tRow.getElementsByTagName("td")
                For Each tCell In tCells
                    results(r, c) = tCell.innerText
                    c = c + 1
                Next
            End If
            headerRow = False
        Next
    Next

    With ws
        .Cells(1, 3).Resize(1, UBound(headers) + 1) = headers
        .Cells(2, 3).Resize(UBound(results, 1), UBound(results, 2)) = results
    End With
    Application.ScreenUpdating = True
End Sub

Refereces:

Microsoft HTML Object Library

回答2:

In general Set elem = Nothing is what you need.

In your code you are assigning the variables within a for-each loop, thus even if you set them to Nothing later, there would not be a performance bonus.

回答3:

Try setting those object to Nothing, like below:

Set elem = Nothing
Set trow = Nothing

I am not sure whether you need variable declarations in your loop, you can take them out of the loop, this might save some time.

But I think your HTTP requests are taking so long, not any VBA code.

UPDATE

Try setting Application.EnableEvents and Application.ScreenUpdating to False at the beggining of macro and setting them back to True at the end.

来源：https://stackoverflow.com/questions/52854186/how-do-i-clean-up-objects-in-excel-vba

标签

html

excel

vba

excel-vba

web-scraping