Question

我有一张电影列表，其中包含A2：A966并且我正在尝试使该过程正常工作但是我的代码会出现运行时错误91.现在它要求输入一个电影的名称输入框的形式（从尽可能多的资源中提取但是我发现最有用的教程使用了一个输入框）但理想情况下它只会运行A2中的电影列表：A966并为数据提取评分为B2：966，总评分为C2：C966

Sub test()
    Dim eRow As Long
    Dim ele As Object
    Dim RowCount As Integer

    Set sht = Sheets("Sheet1")
    RowCount = 1
    sht.Range("A" & RowCount) = "IMDB Rating"
    sht.Range("B" & RowCount) = "Total Reviews"
    eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Set objIE = CreateObject("InternetExplorer.Application")
    'strSearch = Range("A2")
    moviename = InputBox("Enter movie name")

    With objIE
        .Visible = True
        .navigate "http://www.imdb.com/"

        Do While .Busy Or _
          .readystate <> 4
            DoEvents
        Loop

        Set nam = .document.getElementsByName("navbar-query")
        nam.Item(0).Value = moviename

        .document.getElementsByID("navbar-submit-button").Click
        .document.getElementsByID("result_text").Click

        Do While .Busy Or _
          .readystate <> 4
            DoEvents
        Loop

        For Each ele In .document.all
            Select Case ele.classname
                Case "Result"
                    RowCount = RowCount + 1
                Case "ratingValue"
                    sht.Range("A" & RowCount) = ele.innertext
                Case "ratingCount"
                    sht.Range("B" & RowCount) = ele.innertext
            End Select
        Next ele
    End With

    Set objIE = Nothing
End Sub

Answer 1

你可以通过几种方式实现这一目标。这是其中之一。试一试：

<p class="example"></p>

输出：

.example:hover ~ .trans-box-holder #trans_box_1

Answer 2

Sub imd_data()


 Dim IE As New InternetExplorer, html As HTMLDocument, ele As Object

    With IE
        .Visible = True
        .navigate "http://www.google.com/"
        Do Until .readyState = READYSTATE_COMPLETE: Loop
        Set html = .document
        Set sht = Sheets("Sheet2")
    End With

    html.getElementById("lst-ib").Value = sht.Range("A2") & " IMDB"
    html.getElementById("btnK").Click
    Application.Wait Now + TimeValue("00:00:05")
    html.getElementsByClassName("rc")(0).getElementsByTagName("a")(0).Click
    Application.Wait Now + TimeValue("00:00:05")

    For Each ele In html.getElementsByClassName("imdbRating")
        With ele.getElementsByClassName("ratingValue")
            'If .Length Then r = r + 1: Cells(r, 1) = .Item(0).innerText
            sht.Range("B2") = .Item(0).innerText
        End With
        With ele.getElementsByClassName("small")
            'If .Length Then Cells(r, 2) = .Item(0).innerText
             sht.Range("C2") = .Item(0).innerText
        End With
    Next ele

    IE.Quit

End Sub

我正在尝试创建一个宏，它将评级和总评论从IMDB.com拉到excel文件中

2 个答案: