Soru Adrese yazdırmak

Katılım
17 Haziran 2008
Mesajlar
1,836
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
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
 

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,616
Excel Vers. ve Dili
Microsoft 365 Tr-64
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,836
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
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

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,271
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
"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,836
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
"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,836
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
@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

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,271
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Sunucudan "Hazır" response'ı gelip, gelmediği kontrol ediliyor...

.
 
Katılım
17 Haziran 2008
Mesajlar
1,836
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
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

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,271
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
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,836
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
@Haluk


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