2017-01-03 3 views
1

В настоящее время я изучаю TOEFL. То, что я хочу сделать, это написать слова, чтобы преуспеть и получить их значения на турецком языке с веб-сайта. Вот что я сделал до сих пор.Извлечь данные со словарного сайта

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