2017-01-03 69 views
1

我目前正在学习托福。我想要做的就是写出优秀的文字并从网站上用土耳其语重新获得他们的含义。这是我到目前为止所做的。从词典网站检索数据

Sub tureng() 

Dim ieObj 

Set ieObj = CreateObject("InternetExplorer.Application") 
Dim kelime As String 
Dim sht As Worksheet 
Set sht = ThisWorkbook.Sheets("Sayfa1") 
For i = 1 To sht.Range("A10000").End(3).Row 
    kelime = sht.Cells(i, 1).Value 

    With ieObj 
    .Visible = True 
    .Navigate "http://tureng.com/tr/turkce-ingilizce/" & kelime 
    Do While .Busy Or .readyState <> 4 
     DoEvents 
    Loop 
    End With 
Next 

End Sub 

有了这些代码,我可以打开所需的网站,但我不知道如何获得含义。我只想得到前两三个单词。意思与主词在同一行,但它们可以在单独的列中。

回答

1

根据你的回答,这里有一些改进的代码,它具有简单的错误处理,并且更容易适应于给定数量的单词(在你的例子3中)。请注意,这是未经测试,但基于您说的代码正在工作(以及您从哪里删除)...

Sub tureng() 

    Dim ieObj As Object 

    Set ieObj = CreateObject("InternetExplorer.Application") 
    Dim allRowOfData As Object 
    Dim kelime As String 
    Dim sht As Worksheet 

    ' If you are using the values immediately in your sheet, you don't need to store them 

    Set sht = ThisWorkbook.Sheets("Sayfa1") 

    Dim i as Integer 
    Dim j as Integer 

    For i = 1 To sht.Range("A10000").End(3).Row 

     kelime = sht.Cells(i, 1).Value 

     With ieObj 
      .Visible = False 
      .Navigate "http://tureng.com/tr/turkce-ingilizce/" & kelime 
      Do While .Busy Or .readyState <> 4 
      DoEvents 
      Loop 
      Set allRowOfData = ieObj.document.getElementsByClassName("tr ts") 

      ' Very simple error handling code, simply try 3 times regardless of failure 
      On Error Resume Next 
      For j = 1 to 3 ' Loop to get up to 3 values 

       sht.Cells(i, j+1).Value = allRowOfData(j).innertext 

      Next j 
      On Error GoTo 0 

     End With 

    Next I 

    ieObj.Quit 

End Sub