0

我一直试图从 IMDB 获取信息到 Excel 表，到目前为止，我在 excel 中找到了下面的 vba 代码。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Row = Range("A2").Row And _
    Target.Column = Range("A2").Column Then
        Dim IE As New InternetExplorer
        'IE.Visible = True
        IE.Navigate "http://www.imdb.com/title/tt" & Range("A2").Value
        Do
        DoEvents
        Loop Until IE.readyState = READYSTATE_COMPLETE
        Dim Doc As HTMLDocument
        Set Doc = IE.document
        Dim sDD As String
        sDD = Trim(Doc.getElementsByTagName("h1")(0).innerText)
        IE.Quit
        Dim aDD As Variant
        aDD = Split(sDD)
        Range("B2").Value = aDD(0)
    End If
End Sub

现在我想要Range("A2")多个单元格或任何其他代码。

4

2 回答 2

0

这可能是你想要的。它将获取您输入到 excel 列中的名称。然后使用谷歌搜索 IMDB，“我感觉很幸运”，然后抓住电影的“正确”标签，包括年份。

如果您想要 IMDB 参考，您可以使用地址栏或标签中的 tt#########。

'tools > references > Microsoft Internet Controls & Microsoft HTML Object Library need to be ticked

Private Sub Grab_IMDB_Data()
Dim rCurrent As Range
Dim IE As New InternetExplorer
Dim Doc As HTMLDocument
Dim aDD As Variant
Dim x As Integer
Dim y As Integer
Dim i As Integer
Dim NoM As Integer 'Number of Movies
Dim arraymovies() As String 'dynamic array
Dim searchTerm As String

NoM = 1
x = 1 'cell ref hoz
y = 2 'cell ref vert
i = 0

    While Worksheets(3).Cells(y + i, x) <> "" 'finds amount of movies in your list
        NoM = NoM + 1
        i = i + 1
    Wend

ReDim arraymovies(NoM) As String 'sets array to length of movie list

    For i = 1 To NoM 'adds list to array
        arraymovies(i) = Worksheets(3).Cells(i + 1, x).Value 'fills array with values in cells for quick reference
    Next

On Error Resume Next

    For i = 1 To NoM

        'IE.Visible = True
        IE.Navigate "http://google.com/search?btnI=1&q=imdb " & arraymovies(i) 'uses im feeling lucky IMDB
        Do
             DoEvents
        Loop Until IE.readyState = READYSTATE_COMPLETE

        Set Doc = IE.document

        sDD = Trim(Doc.getElementsByTagName("h1")(0).innerText)
        IE.Close
        arraymovies(i) = sDD
    Next

    For i = 1 To NoM 'overlays changes
        Worksheets(1).Cells(i + 1, x) = arraymovies(i)
    Next

End Sub
于 2014-10-21T10:17:54.447 回答
-1

所以你可能有一列说 B:B 填充了这些 imdb 标签，那么你可以做的不是 if 是为每个循环使用一个，请注意我没有测试 InternetExplorer 交互部分：

Private Sub Grab_IMDB_Data
 Dim rCurrent as Range
 Dim IE As New InternetExplorer
 Dim Doc As HTMLDocument
 Dim aDD As Variant
 Dim sDD As String

 For each rCurrent in Range("B:B").Cells
      If rCurrent.Value <>"" Then
           'IE.Visible = True
           IE.Navigate "http://www.imdb.com/title/tt" & Range("A2").Value
           Do
                DoEvents
           Loop Until IE.readyState = READYSTATE_COMPLETE

           Set Doc = IE.document

           sDD = Trim(Doc.getElementsByTagName("h1")(0).innerText)
           IE.Quit

           aDD = Split(sDD)
           rCurrent.Offset(0 ,1).Value = aDD(0)
      End If
  Next rCurrent

End Sub

需要考虑的一个注意事项：实际上从 imdb 网站获取所有这些可能是不合法的。

于 2012-11-01T14:35:32.927 回答