Soru Adrese yazdırmak

Katılım
17 Haziran 2008
Mesajlar
1,471
Excel Vers. ve Dili
Excel 2007-2010 Türkçe
Merhaba arkadaşlar;

Bu koddaki veriyi, F3 adresinden itibaren nasıl yazdırabilirim ?

Kod:
Set th = List.GetElementsByTagName("Td")
For i = 1 To 3
Sheets("MalzemeGuncelFiyatlar").Cells(3, i + 1) = th(i).innertext
Next i
yardımcı arkadaşa şimdiden teşekkürler
 

NextLevel

Altın Üye
Katılım
22 Ekim 2017
Mesajlar
663
Excel Vers. ve Dili
Ofis 2016 TR
F3-G3-H3 e yazdıracaksan
Sheets("MalzemeGuncelFiyatlar").Cells(3, i + 5) = th(i).innertext

F3-F4-F5 yazdıracaksan
Sheets("MalzemeGuncelFiyatlar").Cells(i+2, 6) = th(i).innertext
 
Katılım
17 Haziran 2008
Mesajlar
1,471
Excel Vers. ve Dili
Excel 2007-2010 Türkçe
NextLevel

Hocam çok teşekkürler, Tamamdır...

-----------------------------------

Hocam bir üstteki adresden veri alıyorum. fakat , Tuğla fiyatları haricinde demir fiyatlarıda geliyor. ben sadece tuğla verilerini nasıl alırım ?



Kod:
a = a + 2
Set Tbody = List.GetElementsByTagName("Table")
For Each Tr In Tbody(0).document.all.tags("TR")

For k = 1 To Tr.all.tags("TD").Length - 1
Sheets("MalzemeGuncelFiyatlar").Cells(a, k + 5) = Tr.all.tags("TD").Item(k).innertext
Next k
a = a + 1
Next
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
9,365
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
"Google Sheets" ile, sadece A1 hücresine yazılacak tek formülle tüm tuğla fiyatları alınabilir....


Capture.PNG


Yok, illâ VBA ile yapmam lâzım diyorsanız;

Kod:
Sub Test()
'   Haluk - 12/01/2021
'   sa4truss@gmail.com

    Dim myUrl As String
 
    myUrl = "https://www.yapikulubu.com/tugla-fiyatlari/"
 
    With ActiveSheet.QueryTables.Add(Connection:="URL;" & myUrl, Destination:=Range("$A$1"))
        .Name = "myTable"
        .RefreshStyle = xlOverwriteCells
        .AdjustColumnWidth = True
     
        .RefreshPeriod = 0
     
        .WebSelectionType = xlSpecifiedTables
        .WebTables = 1
     
        .WebFormatting = xlWebFormattingNone
        .Refresh BackgroundQuery:=False
    End With
End Sub

Veya, VBA'de XMLHTTP ile "GET" metodu kullanarak;

Kod:
Sub GetData()
    ' Haluk - 12/01/2021
    '
    Dim HTTP As Object, HTML As Object
    Dim URL As String
    Dim noRows As Byte, noColumns As Byte
    Dim Table As Object, Tables As Object, myTable As Object

    Range("B1:E" & Rows.Count) = Empty
 
    URL = "https://www.yapikulubu.com/tugla-fiyatlari/"
 
    Set HTTP = CreateObject("MSXML2.XMLHTTP")
    Set HTML = CreateObject("HTMLFILE")
 
    HTTP.Open "GET", URL, False
    HTTP.send
 
    If HTTP.Status = 200 Then
        HTML.body.innerhtml = HTTP.responseText
     
        Set Tables = HTML.getElementsByTagName("table")
        If Tables.Length > 0 Then
            Set myTable = Tables(0)
         
            noRows = myTable.Rows.Length
            For i = 2 To noRows - 1
                For j = 1 To myTable.Rows(i).Cells.Length
                    Cells(i, j) = myTable.Rows(i).Cells(j - 1).innerText
                Next
            Next
        End If
    End If
    Columns.AutoFit
    Set Tables = Nothing
    Set HTML = Nothing
    Set HTTP = Nothing
End Sub
.
 
Son düzenleme:
Katılım
17 Haziran 2008
Mesajlar
1,471
Excel Vers. ve Dili
Excel 2007-2010 Türkçe
"Google Sheets" ile, sadece A1 hücresine yazılacak tek formülle tüm tuğla fiyatları alınabilir....


Ekli dosyayı görüntüle 224422


Yok, illâ VBA ile yapmam lâzım diyorsanız;

Kod:
Sub Test()
'   Haluk - 12/01/2021
'   sa4truss@gmail.com

    Dim myUrl As String

    myUrl = "https://www.yapikulubu.com/tugla-fiyatlari/"

    With ActiveSheet.QueryTables.Add(Connection:="URL;" & myUrl, Destination:=Range("$A$1"))
        .Name = "myTable"
        .RefreshStyle = xlOverwriteCells
        .AdjustColumnWidth = True
   
        .RefreshPeriod = 0
   
        .WebSelectionType = xlSpecifiedTables
        .WebTables = 1
   
        .WebFormatting = xlWebFormattingNone
        .Refresh BackgroundQuery:=False
    End With
End Sub

Veya, VBA'de XMLHTTP ile "GET" metodu kullanarak;

Kod:
Sub GetData()
    ' Haluk - 12/01/2021
    '
    Dim HTTP As Object, HTML As Object
    Dim URL As String
    Dim noRows As Byte, noColumns As Byte
    Dim Table As Object, Tables As Object, myTable As Object

    Range("B1:E" & Rows.Count) = Empty

    URL = "https://www.yapikulubu.com/tugla-fiyatlari/"

    Set HTTP = CreateObject("MSXML2.XMLHTTP")
    Set HTML = CreateObject("HTMLFILE")

    HTTP.Open "GET", URL, False
    HTTP.send

    If HTTP.Status = 200 Then
        HTML.body.innerhtml = HTTP.responseText
   
        Set Tables = HTML.getElementsByTagName("table")
        If Tables.Length > 0 Then
            Set myTable = Tables(0)
       
            noRows = myTable.Rows.Length
            For i = 2 To noRows - 1
                For j = 1 To myTable.Rows(i).Cells.Length
                    Cells(i, j) = myTable.Rows(i).Cells(j - 1).innerText
                Next
            Next
        End If
    End If
    Columns.AutoFit
    Set Tables = Nothing
    Set HTML = Nothing
    Set HTTP = Nothing
End Sub
.
Hocam çok teşekkür ederim ., telefondan yazıyorum .,, büyük ihtimalle çalışacaktır . Bu konuda eksik bilgilerim vardı. İki gündür uğraşıyorum ve epey ilerledim., göndermiş olduğunuz kod örnekleri ile ...

Çok teşekkürler
 
Katılım
17 Haziran 2008
Mesajlar
1,471
Excel Vers. ve Dili
Excel 2007-2010 Türkçe
@Haluk

"GET" metodu kullanarak;
----------------

Hocam kodlarınıza ;

Kod:
'TUĞLA İSİMLERİ KISMI------
..
Set List = HTML.getElementById("Page")
...
Set th = List.getElementsByTagName("Td")
For f = 1 To 3
Sheets("MalzemeGuncelFiyatlar").Cells(3, f + 4) = th(f).innerText
Next f
'------------------------
End If
Bu şekilde bir ekleme yaptım., sonuc doğru. Fakat sizin kodlar içinde, daha kısa yazılışı var mıdır ?

* Excel tablomdaki adres içinde şu değişikliği yaptım.. : Cells(i + 2, j + 3) = myTable.Rows(i).Cells(j - 1).innerText

* If HTTP.Status = 200 Then .. burdaki 200 ün tam olarak anlamı nedir ?




Teşekkürler.
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
9,365
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
Sunucudan "Hazır" response'ı gelip, gelmediği kontrol ediliyor...

.
 
Katılım
17 Haziran 2008
Mesajlar
1,471
Excel Vers. ve Dili
Excel 2007-2010 Türkçe
Sunucudan "Hazır" response'ı gelip, gelmediği kontrol ediliyor...

.
Teşekkürler.

şu an yazmış olduğunuz kod ile aynı sitededeki diğer sayfalardan da veri aldım. küçük değişikliklerle... şablon gibi oldu yani..

Hocam aynı sayfada iki yada daha fazla tablo varsa o zaman nasıl bir ekleme yapılmalı ?
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
9,365
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
Tablonun "index" değerine göre istediğiniz tabloyu alırsınız...

Tables(0) ifadesi, sıfır tabanlı dizi olduğu için sayfadaki 1. tablo olduğunu söylüyor....
 
Katılım
17 Haziran 2008
Mesajlar
1,471
Excel Vers. ve Dili
Excel 2007-2010 Türkçe
@Haluk


Tamam hocam Teşekkürler., deneyeceğim.
 
Üst