Soru Adrese yazdırmak

[k0081]

Merhaba arkadaşlar;

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

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

 

[ÖmerFaruk]

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

 

[k0081]

NextLevel

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

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

Tuğla Fiyatları 2022 Listesi | Yapı Kulübü

Tuğla Fiyatlari 2022 Listesi | 8,5 ve 13,5 tugla, yigma, asmolen, izo tugla, baca ve sömine tuglasi, dekoratif tuğla, ateş, harman, cam tugla.

www.yapikulubu.com

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 ?

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]

"Google Sheets" ile, sadece A1 hücresine yazılacak tek formülle tüm tuğla fiyatları alınabilir....





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

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;

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

.

 

[k0081]

"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;

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;

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

 

[k0081]

@Haluk

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

Hocam kodlarınıza ;

'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]

Sunucudan "Hazır" response'ı gelip, gelmediği kontrol ediliyor...

.

 

[k0081]

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]

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....

 

[k0081]

@Haluk


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