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

-1

so you might have a column say B:B filled with these imdb tags, then what you can do in stead of the if is use a for each loop, please be aware that I haven't tested for the InternetExplorer interaction part:

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

One note for consideration: it might not be legal to actually grab all this from the imdb website.

于 2012-11-01T14:35:32.927 に答える