Web'den Tablo İçindeki veriyi alma

K

Kusta

Katılım
30 Kasım 2018
Mesajlar
91
Excel Vers. ve Dili
2016
Arkadaşlar Web sayfasından veri alırken aşağıdaki kodla web sitesindeki 5. tablodaki verileri excele aktarıyorum. Ancak 5.tablo içerisinde alt alta satırlar var ve veri alırken ben sadece ilk satırı (en üst satırı da diyebilirim) almak istiyorum. Nasıl yapabilirim.


Dim y As Long, z As Long, wb As Excel.Workbook, ws As Excel.Worksheet

Set wb = Excel.ActiveWorkbook
Set ws = wb.ActiveSheet

y = 2 'Column A in Excel
z = 1 'Row 1 in Excel
Do While IE.Busy: DoEvents: Loop
Do While IE.ReadyState <> 4: DoEvents: Loop

Set doc = IE.Document
Set hTable = doc.GetElementsByTagName("table")
Set tb = hTable(5)
Set hBody = tb.GetElementsByTagName("tbody")

For Each bb In hBody
Set hTR = bb.GetElementsByTagName("tr")
For Each tr In hTR
Set hTD = tr.GetElementsByTagName("td")
y = 2 ' Resets back to column A
For Each td In hTD
ws.Cells(i, y).Value = td.innertext
y = y + 1
Next td
DoEvents
z = z + 1
Next tr
Next bb
 
K

Kusta

Katılım
30 Kasım 2018
Mesajlar
91
Excel Vers. ve Dili
2016
Biraz acil cevap verebilecek olan var mı. Teşekkür ederim şimdiden.
 
A

askm

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,745
Excel Vers. ve Dili
2010-2016
Kod: 
For Each td In hTD
ws.Cells(y, z).Value = td.innertext
y = y + 1
Next td
DoEvents
Exit for
şeklinde deneyin. Kodda i yok
 
K

Kusta

Katılım
30 Kasım 2018
Mesajlar
91
Excel Vers. ve Dili
2016
askm' Alıntı:
Kod: 
For Each td In hTD
ws.Cells(y, z).Value = td.innertext
y = y + 1
Next td
DoEvents
Exit for
şeklinde deneyin. Kodda i yok
Genişletmek için tıkla ...
Şöyle bir durum var. for döngüsünü sonlandırmamam gerekiyor. Çünkü A sütununda yer alan TC lerin hepsi ile sorgulama yapıp karşılarına yazıyor. Aşağıdaki formülde A sütununda yer alan TC leri tek tek sorguluyor ve karşısına veriler yazılıyor. Ancak dediğim gibi webdeki tabloda yer alan satırların hepsini sorguladığım TC nin karşısına yani o sütuna yazıyor. Kullandığım makronun tamamı aşşağıdaki gibidir ve ben web'deki tablonun İlk satırnı excele aktardıktan sonra diğer TC ile sorgulamaya devam etmesini nasıl sağlayabilirim. next td bittikten sonra next tr yapmadan diğer TC sorgulamasına geçip işlemlere devam etmeli diye düşünüyorum ama beceremedim.

Şimdiden teşekkür ederim.



Sub sonuc()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
Application.Wait Now + TimeValue("00:00:02")
IE.Navigate "https://portalint.KisiKontrol" 'İnternet sitesini paylaşamıyorum çünkü server'dan giriyoruz. Siz giremezsiniz.
Application.Wait Now + TimeValue("00:00:02")
IE.Width = 1500
IE.Height = 1000
IE.Visible = False
While IE.Busy
DoEvents
Wend
son = Cells(Rows.Count, "A").End(3).Row
For i = 2 To son
If Cells(i, "B") = "İŞLEM TAMAM" Then
GoTo 0
Else
IE.Document.getElementById("ctl02_ctlAraKimlikNo").Value = Cells(i, "A")
IE.Visible = False
While IE.Busy
DoEvents
Wend

On Error Resume Next
IE.Document.getElementById("ctl02_PageCommand1_CommandItem_Search").Click
On Error GoTo 0
IE.Visible = False
While IE.Busy
DoEvents
Wend


On Error Resume Next
Dim y As Long, z As Long, wb As Excel.Workbook, ws As Excel.Worksheet

Set wb = Excel.ActiveWorkbook
Set ws = wb.ActiveSheet

y = 3 'Column A in Excel
z = 1 'Row 1 in Excel
Do While IE.Busy: DoEvents: Loop
Do While IE.ReadyState <> 4: DoEvents: Loop

Set doc = IE.Document
Set hTable = doc.GetElementsByTagName("table")
Set tb = hTable(2)
Set hBody = tb.GetElementsByTagName("tbody")

For Each bb In hBody
Set hTR = bb.GetElementsByTagName("tr")
For Each tr In hTR
Set hTD = tr.GetElementsByTagName("td")

For Each td In hTD
ws.Cells(i, y).Value = td.innertext
y = y + 1
Next td
DoEvents
z = z + 1

Next tr
Next bb


On Error GoTo 0
IE.Visible = False
While IE.Busy
DoEvents
Wend



Cells(i, "B") = "İŞLEM TAMAM"
IE.Visible = False
While IE.Busy
DoEvents
Wend
0:

End If
Next
IE.Quit
MsgBox "İŞLEM TAMAMLANDI"

End Sub
 
K

Kusta

Katılım
30 Kasım 2018
Mesajlar
91
Excel Vers. ve Dili
2016
konu ile ilgili yorum yapabilecek var mıdır?
 
E

excelokyanus500

Katılım
20 Şubat 2012
Mesajlar
242
Excel Vers. ve Dili
office2007 Türkçe
Fikir vermesi açısından inceleyiniz....
Kod: 
Sub Deneyin()
'On Error Resume Next
    Dim ie              As Object
    Dim i               As Long: i = 1
    Dim Elements        As Object
    Dim Element         As Object


    Set ie = CreateObject("InternetExplorer.Application")
  
With ie
        .navigate ("https://www.garantibbva.com.tr/doviz-kurlari")                               'urlniz
        While .Busy Or .ReadyState <> 4: DoEvents: Wend
    For Each Element In ie.document.getElementsByTagName("table")(0).getElementsByTagName("tr") ' Burada table(0) size göre (2) olmalı .Burda tablede tr geziyoruz.
            For k = 0 To Element.getElementsByTagName("td").Length - 1                           'Burada (tr) içinde (td) geziyoruz.
              If Element.getElementsByTagName("td")(k).innerText Like "*USD*" Then               'Varsa bir kriteriniz isim gibi
              
               Cells(i, k + 1) = Element.getElementsByTagName("td")(0).innerText 
               Cells(i, k + 2) = Element.getElementsByTagName("td")(1).innerText
               Cells(i, k + 3) = Element.getElementsByTagName("td")(2).innerText
               Cells(i, k + 4) = Element.getElementsByTagName("td")(3).innerText
             Else
           End If
        Next
         i = i + 1
    Next
        
End With
End Sub
 
K

Kusta

Katılım
30 Kasım 2018
Mesajlar
91
Excel Vers. ve Dili
2016
excelokyanus500' Alıntı:
Fikir vermesi açısından inceleyiniz....
Kod: 
Sub Deneyin()
'On Error Resume Next
    Dim ie              As Object
    Dim i               As Long: i = 1
    Dim Elements        As Object
    Dim Element         As Object


    Set ie = CreateObject("InternetExplorer.Application")
 
With ie
        .navigate ("https://www.garantibbva.com.tr/doviz-kurlari")                               'urlniz
        While .Busy Or .ReadyState <> 4: DoEvents: Wend
    For Each Element In ie.document.getElementsByTagName("table")(0).getElementsByTagName("tr") ' Burada table(0) size göre (2) olmalı .Burda tablede tr geziyoruz.
            For k = 0 To Element.getElementsByTagName("td").Length - 1                           'Burada (tr) içinde (td) geziyoruz.
              If Element.getElementsByTagName("td")(k).innerText Like "*USD*" Then               'Varsa bir kriteriniz isim gibi
             
               Cells(i, k + 1) = Element.getElementsByTagName("td")(0).innerText
               Cells(i, k + 2) = Element.getElementsByTagName("td")(1).innerText
               Cells(i, k + 3) = Element.getElementsByTagName("td")(2).innerText
               Cells(i, k + 4) = Element.getElementsByTagName("td")(3).innerText
             Else
           End If
        Next
         i = i + 1
    Next
       
End With
End Sub
Genişletmek için tıkla ...
Teşekkür ederim. Fakat alt alta olan bütün satırlara bakmasına gerek yok. Sadece ilk satıra baktırabilirmiyiz. Yani sadece 1.tr içindeki td lere baksın.
 
E

excelokyanus500

Katılım
20 Şubat 2012
Mesajlar
242
Excel Vers. ve Dili
office2007 Türkçe
Merhaba,

Çeşitli yaklaşımlar var. İstediğiniz bu şekilde mi tahminle gidiyoruz.
Bu arada Selenium vba ile bu işi çok daha basit bir kaç satır kod ile
yapabilirsiniz.



Kod: 
Sub dene2()

Dim ie

Dim webpage 

Set ie = CreateObject("InternetExplorer.Application")
'ie.Visible = True

ie.navigate ("https://www.garantibbva.com.tr/doviz-kurlari")
Do While ie.readyState = 4: DoEvents: Loop
Do Until ie.readyState = 4: DoEvents: Loop
While ie.Busy
    DoEvents
Wend

Set webpage = ie.document
Set tablo = webpage.getElementsByTagName("Table")(0) 'Sizin tablo numaranız
Set tablo_data = tablo.getElementsByTagName("tr")
Cells(1, 1) = tablo_data.Item(0).innerText
Cells(2, 1) = tablo_data.Item(0).Children(0).innerText ' Veya
Cells(3, 1) = tablo_data.Item(0).FirstChild.innerText
Cells(4, 1) = tablo_data.Item(0).Children(1).innerText
Cells(5, 1) = tablo_data.Item(0).Children(2).innerText
   
Set ie = Nothing
End Sub
 
K

Kusta

Katılım
30 Kasım 2018
Mesajlar
91
Excel Vers. ve Dili
2016
excelokyanus500' Alıntı:
Merhaba,

Çeşitli yaklaşımlar var. İstediğiniz bu şekilde mi tahminle gidiyoruz.
Bu arada Selenium vba ile bu işi çok daha basit bir kaç satır kod ile
yapabilirsiniz.



Kod: 
Sub dene2()

Dim ie

Dim webpage

Set ie = CreateObject("InternetExplorer.Application")
'ie.Visible = True

ie.navigate ("https://www.garantibbva.com.tr/doviz-kurlari")
Do While ie.readyState = 4: DoEvents: Loop
Do Until ie.readyState = 4: DoEvents: Loop
While ie.Busy
    DoEvents
Wend

Set webpage = ie.document
Set tablo = webpage.getElementsByTagName("Table")(0) 'Sizin tablo numaranız
Set tablo_data = tablo.getElementsByTagName("tr")
Cells(1, 1) = tablo_data.Item(0).innerText
Cells(2, 1) = tablo_data.Item(0).Children(0).innerText ' Veya
Cells(3, 1) = tablo_data.Item(0).FirstChild.innerText
Cells(4, 1) = tablo_data.Item(0).Children(1).innerText
Cells(5, 1) = tablo_data.Item(0).Children(2).innerText
  
Set ie = Nothing
End Sub
Genişletmek için tıkla ...
Çok teşekkür ederim şimdi istediğim gibi çalıştırabiliyorum
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst