Kod: (Rahat kopyalayabilmeniz i in t m kodu se menizi sa lar) Sub test() On Error Resume Next sor =

   
http://www.equasis.org sitesinden b t n gemilerin isimlerini ve bilgilerini ekmek istiyorum. Kullan c Ad : atillaciftci@gmail.com ifre : 1234567 Giri yapt ktan sonra Ship Search k sm na girip tek tek gemi isimlerini yaz p bilgilere ula abiliyorum ben b t n listeyi excel e ekip s zme i lemini excel de yapmak istiyorum m mk nm d r.  
Merhaba, stedi iniz m mk n. Ship Search k sm i in de rnek verebilir misiniz? __________________ ================================ zel mesaj ile soru sormay n. Ki isel Sayfam : http://www.excel.web.tr/derres/zeki/anasayfa.htm  
Kodu bo module yap t r p "F5" ile al t r p test edin.
Kod: (Rahat kopyalayabilmeniz i in t m kodu se menizi sa lar) Sub test() On Error Resume Next sor = InputBox("anahtar kelimeyi yaz n", "www.excel.web.tr") If Len(Trim(sor)) = 0 Then Exit Sub With CreateObject("InternetExplorer.Application") .navigate "http://www.equasis.org" Do Until .ReadyState = 4: Loop Do While .Busy: Loop .document.all.j_email.Value = "atillaciftci@gmail.com" .document.all.j_password.Value = "1234567" .document.all.submit.Click Do Until .ReadyState = 4: Loop Do While .Busy: Loop .navigate gen con "http://www.equasis.org/EquasisWeb/restricted/ShipSearch?fs=ShipSearch" Do Until .ReadyState = 4: Loop Do While .Busy: Loop .document.all.p_name.Value = sor .document.all.submit.Click Do Until .ReadyState = 4: Loop Do While .Busy: Loop For Each t In .document.all.tags("table") If t.innerhtml Like "*Name of ship*" Then For i = 0 To t.Rows.Length - 1 For j = 0 To t.Rows(i).Cells.Length - 1 Cells(i gen con + 1, j + 1) = t.Rows(i).Cells(j).innerText Next Next Exit For End If Next .Quit End With If Err Then MsgBox Err.Description End Sub __________________ ================================ zel mesaj ile soru sormay n. Ki isel Sayfam : http://www.excel.web.tr/derres/zeki/anasayfa.htm gen con  
Kod: (Rahat gen con kopyalayabilmeniz i in t m kodu se menizi sa lar) Sub test() On Error Resume Next sor = InputBox("anahtar gen con kelimeyi yaz n", "www.excel.web.tr") If Len(Trim(sor)) = 0 Then Exit Sub With CreateObject("InternetExplorer.Application") .navigate "http://www.equasis.org" Do Until .ReadyState = 4: Loop Do While .Busy: Loop .document.all.j_email.Value = "atillaciftci@gmail.com" .document.all.j_password.Value = "1234567" .document.all.submit.Click Do Until .ReadyState = 4: Loop Do While .Busy: Loop .navigate "http://www.equasis.org/EquasisWeb/restricted/ShipSearch?fs=ShipSearch" Do Until .ReadyState = 4: Loop Do While .Busy: Loop .document.all.p_name.Value = sor .document.all.submit.Click Do Until .ReadyState gen con = 4: Loop Do While .Busy: Loop For Each t In .document.all.tags("table") If t.innerhtml Like "*Name of ship*" Then For i = 0 To t.Rows.Length - 1 For j = 0 To t.Rows(i).Cells.Length - 1 Cells(i + 1, j + 1) = t.Rows(i).Cells(j).innerText Next Next Exit For End If Next .Quit End With If Err Then MsgBox Err.Description gen con End Sub
Kod: (Rahat kopyalayabilmeniz i in t m kodu se menizi sa lar) Sub test() On Error Resume Next sor = InputBox("anahtar kelimeyi yaz n", "www.excel.web.tr") If Len(Trim(sor)) = 0 Then Exit Sub With CreateObject("InternetExplorer.Application") .navigate "http://www.equasis.org" '.Visible = 1 Do Until .ReadyState = 4: Loop Do While .Busy: Loop .document.all.j_email.Value = "atillaciftci@gmail.com" .document.all.j_password.Value = "1234567" .document.all.submit.Click Do Until .ReadyState = 4: Loop Do While .Busy: Loop .navigate "http://www.equasis.org/EquasisWeb/restricted/ShipSearch?fs=ShipSearch" Do Until .ReadyState = 4: Loop Do While .Busy: Loop .document.all.p_name.Value = sor .document.all.submit.Click gen con Do Until .ReadyState = 4: Loop Do While .Busy: Loop For Each t In .document.all.tags("table") If LCase(t.innerhtml) Like "*name of ship*" Then x = Split(t.Rows(2).Cells(0).innerhtml, "'")(1) Exit For End If Next .goback Do Until .ReadyState = 4: Loop Do While .Busy: Loop .document.all.p_imo.Value gen con = x .document.all.submit.Click Do Until .ReadyState = 4: Loop Do While .Busy: Loop Set sh = Sheet2 sat = sh.[b65536].End(3).Row + 1 s = 1 Set t = .document.getElementsByTagName("table").Item(5) For i = 0 To t.Rows.Length - 1 s = s + 1 For j = 0 To t.Rows(i).Cells.Length - 1 sh.Cells(sat, s) = t.Rows(i).Cells(1).innerText Next Next Set t = .document.getElementsByTagName("table").Item(12) For i = 2 To t.Rows.Length - 1 s = s + 1 For j = 0 To t.Rows(i).Cells.Length - 1 sh.Cells(sat, s) = t.Rows(i).Cells(2).innerText Next Next Set t = .document.getElementsByTagName("table").Item(16) s = s + 1 sh.Cells(sat, s) = t.Rows(1).Cells(0).innerText gen con Set t = .document.getElementsByTagName("table").Item(20) s = s + 1 sh.Cells(sat, s) =