Sözlük internet sitesi

[VeliDemir]

Merhaba. Öncelikle, böyle bir hizmeti sunduğunuzdan ötürü sizlere teşekkür ederim.

Bir Excel dosyasında çalıştırılacak makro program sayesinde çıkacak pop up ekrana İngilizce kelimeler yazıldıktan sonra bu kelimeler A sütununa aralarında bir satır boşluk olacak şekilde yazılsın (Yani ilk kelime A1 hücresine, ikinci kelime A3 hücresine, üçüncü kelime A5 hücresine v.s. yazılsın.) ve daha sonra bu kelimelerin manaları https://www.lexico.com internet sitesinden alınıp karşılarındaki B sütununa yazılsın (Yani ilk kelimenin manası B1 hücresine, ikinci kelimenin manası B3 hücresine, üçüncü kelimenin B5 hücresine v.s. yazılsın.)

İyi günler.

 

[VeliDemir]

Merhaba.
Bu talebime benzer bir talebi aşağıdaki makro programıyla gerçekleştırmiştim. Aşağıdaki makro programını modifiye edilerek talebimi gerçekleştirmenizi sizlerden rica ediyorum.

Sub test()
Dim ie As Object
Set s1 = ThisWorkbook.Worksheets("Sheet 1")
Set ie = CreateObject("internetexplorer.application")
s1.AutoFilterMode = False
s1.Range("B:C").Clear
ie.Visible = True
ie.navigate "lexico.com"
Do: DoEvents: Loop Until Not ie.readystate <> 4
Bekle 1500


On Error Resume Next

For i = 1 To s1.Range("A65536").End(xlUp).Row

ie.document.getElementById("q").Value = s1.Cells(i, 1)
ie.document.getElementById("searchBtn").Click
Do: DoEvents: Loop Until Not ie.readystate <> 4
Bekle 3500

tx = ie.document.body.innertext
s = InStr(1, tx, "Pronunciation: /", vbTextCompare)
If s = 0 Then
s1.Cells(i, 2) = "-"
s1.Cells(i, 3) = "Pronunciation: / bulunamadı"
If InStr(1, tx, "No exact results found for ", vbTextCompare) > 0 Then
s1.Cells(i, 3) = "No exact results found"
End If

Else
tx = Mid(tx, s + Len("Pronunciation: /"), 100)
s = InStr(1, tx, "/", vbTextCompare)
tx = Mid(tx, 1, s - 1)
s1.Cells(i, 2) = tx
End If
Set ie.document = Nothing

Next i
Set ie = Nothing
s1.Columns.AutoFit
End Sub

Private Function Bekle(ByVal MiliSaniye As Integer)
Dim t1 As Double
Dim t2 As Double
t1 = Timer + MiliSaniye / 1000
Do
DoEvents
t2 = Timer
Loop Until t2 > t1
End Function