Error Division by Zero in Excel VBA

2019-08-05 17:11发布

Hy Experts, I am new here, I am getting problem with my Excel VBA Code that is use to extract the data over the website. I have two sheets with name as "Input" & "Output" that looks like this....

Iputsheet

Output

The first sheet will get a url as an input and than run the code written below...

  Sub extractTablesData()
Dim IE As Object, obj As Object
Dim str, e As String
Dim pgf, pgt, pg As Integer
Dim ele, Results As Object
Dim add, size, cno, price, inurl, sp, sp1 As String
Dim isheet, rts As Worksheet
Dim LastRow As Long
Set IE = CreateObject("InternetExplorer.Application")


Set isheet = Worksheets("InputSheet")
Set rts = Worksheets("Results")

url = isheet.Cells(3, 2)

RowCount = 1
    rts.Range("A" & RowCount) = "Address"
    rts.Range("B" & RowCount) = "Size"
    rts.Range("C" & RowCount) = "Contact Number"
    rts.Range("D" & RowCount) = "Price"
    rts.Range("E" & RowCount) = "Url"
LastRow = rts.Cells(Rows.Count, 2).End(xlUp).Row
  'RowCount = LastRow

 With IE
    .Visible = True
    .Navigate (url)

DoEvents
Do While IE.busy Or IE.readystate <> 4
Loop

'Application.Wait (Now + #12:00:05 AM#)

For Each Results In .Document.all
    Select Case Results.className
        Case "title search-title"
            str = Results.innerText
            str1 = Split(str, " ")
            str = CInt(str1(0))
 End Select
    If Results.className = "btn btn-main-inverted dropdown-toggle" And InStr(1, Results.Title, " page") > 2 Then
        str2 = Results.Title
        str1 = Split(str2, " ")
        str2 = CInt(str1(0))
    End If
Next
pgno = WorksheetFunction.RoundUp(str / str2, 0)

End With
IE.Quit

Set IE = Nothing




UrlS = Split(url, "?")
Url1 = UrlS(0)
Url2 = "?" & UrlS(1)

For i = 1 To pgno
Set IE = CreateObject("InternetExplorer.Application")
url = Url1 & "/" & i & Url2
With IE
    .Visible = True
    .Navigate (url)

DoEvents
Do While IE.busy Or IE.readystate <> 4
Loop

'Application.Wait (Now + #12:00:08 AM#)
For Each ele In .Document.all


    Select Case ele.className
        Case "listing-img-a"
            inurl = ele.href
            rts.Cells(LastRow + 1, 5) = inurl

        Case "listing-location"
            LastRow = LastRow + 1
            add = ele.innerText
            rts.Cells(LastRow, 1) = add

        Case "lst-sizes"
            sp = Split(ele.innerText, " ·")

            size = sp(0)
            rts.Cells(LastRow, 2) = size

        Case "pgicon pgicon-phone js-agent-phone-number"      ' btn-tools" 'pgicon pgicon-phone js-agent-phone-number" 'agent-phone-number"
            rts.Cells(LastRow, 3) = ele.innerText

        Case "listing-price"
            price = ele.innerText
            rts.Cells(LastRow, 4) = price



End Select

Next
LastRow = rts.Cells(Rows.Count, 2).End(xlUp).Row
rts.Activate
rts.Range("A" & LastRow).Select

End With
IE.Quit
Set IE = Nothing
Application.Wait (Now + #12:00:04 AM#)
Next i






MsgBox "Success"


End Sub

after execution of this code I am getting this error....

Error Message after code execution

after debugging I am getting this field as highlighted.... Debug Message

Please check and make me the correction where I am getting error... This code will extract the data after successful running, and at the end it will run the message box with message as "Success"...

1条回答
相关推荐>>
2楼-- · 2019-08-05 17:20

Getting the actual info off the page efficiently:

You could try the following method which uses CSS selectors.

The "." means class and " a" means a tags within preceeding parent element.

Example: So CSS pattern .listing-info a would be a tags within parent element(s) having class = listing-info.

querySelectorAll will find all matching elements having this CSS pattern and return a nodeList.

Option Explicit
Public Sub GetListings()
    Dim IE As New InternetExplorer
    Application.ScreenUpdating = False
    With IE
        .Visible = True
        .navigate "https://www.propertyguru.com.sg/singapore-property-listing/property-for-sale?limit=30&market=residential&property_type_code%5B%5D=4S&property_type=H&freetext=Yishun", False
        While .Busy Or .readyState < 4: DoEvents: Wend

        Dim addresses As Object, address As Object, sizes As Object, prices As Object, _
        listingIds As Object, i As Long, urls As Object

        With .document
            Set addresses = .querySelectorAll(".listing-location")
            Set listingIds = .querySelectorAll(".listing-item")
            Set sizes = .querySelectorAll(".lst-sizes")
            Set prices = .querySelectorAll(".price")
            Set urls = .querySelectorAll(".listing-info a")
        End With
        Dim headers()
        headers = Array("Address", "Size", "ListingId", "Price", "Url")
        With ActiveSheet
            .Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
            For i = 0 To addresses.Length - 1
                .Cells(i + 2, 1) = addresses.item(i).innerText
                .Cells(i + 2, 2) = Split(sizes.item(i).innerText, "S$")(0)
                .Cells(i + 2, 3) = Split(Split(listingIds.item(i).outerHTML, "listing-id-")(1), Chr$(32))(0)
                .Cells(i + 2, 4) = "S$" & prices.item(i).innerText
                .Cells(i + 2, 5) = "https://www.propertyguru.com.sg/" & urls.item(i).getAttribute("href")
            Next i
        End With
        .Quit
    End With
    Application.ScreenUpdating = True
End Sub

Getting the number of pages:

You could use a function to get the number of pages in a more reliable way. You can then amend the code above to loop from 1 to pgno very easily.

Sub Main
     Dim pgno As Long
    'your other code
    pgno  = GetNumberOfPages(.document)
    'other code
End Sub

Public Function GetNumberOfPages(ByVal doc As HTMLDocument) As Long
    On Error GoTo errhand:
    GetNumberOfPages = doc.querySelector(".listing-pagination li:nth-last-child(2)").innerText
    Exit Function
errhand:
   If Err.Number <> 0 Then GetNumberOfPages = 1
End Function

Notes on your code from my original non-answer:

I would go with what I have written above and amend into a loop but here are my observations on your code:

0) Main division by 0 error

You need to handle the divide by zero error of str2 = 0. For example:

You could declare pgno as Variant and have

If str2 = 0 Then 
    pgNo = CVErr(xlErrDiv0)
Else 
    pgno = WorksheetFunction.RoundUp(str / str2, 0)
End If

1) Also, note that when you have multiple declarations on the same line and only declare the type of one, then all the undeclared types implicitly are variant.

E.g.

Dim add, size, cno, price, inurl, sp, sp1 As String

Only sp1 is a String. Everthing else is a variant.

If all strings then declare as:

Dim add As String, size As String, cno As String, price As String, inurl As String,  sp1 As String

I exclude sp As String because I think it should be sp() As String.

And as add and size are methods in VBA, I would avoid using them as variable names, and go with iAdd or iSize, or something more descriptive and useful that cannot be considered ambiguous.

2) You also do not have to use hungarian/pseudo-hungarian notation e.g. str.

3) Use Integer not Long

4) Use Option Explicit and check you datatypes. For example, as mentioned in comments, did you mean for str1 to be a string that you are using in division? Are you relying on an implicit conversion? Don't. Declare as the expected type.

For example: Dim str1() As String, str2 As String, pgno As Double

This will also highlight that you have missing variable declarations e.g. RowCount.

查看更多
登录 后发表回答