Question

我一直试图从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")多个单元格或任何其他代码。

Answer 1

这可能是你想要的。它将获取您输入到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

Answer 2

所以你可能有一个列说B：B填充了这些imdb标签，那么你可以做什么而不是if使用a为每个循环，请注意我没有测试过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网站实际获取所有这些内容可能不合法。

IMDB信息Graber在Excel中

2 个答案: