Güncel Market Fiyatları İnternetten Bulmak

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,270
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
C#:
Sub Test()
'   Haluk - 10/05/2022

    Dim objHTTP As Object, strURL As String
    Dim HTML As Object, Tables As Object, Table As Object
    Dim x As Integer, i As Long, iRow As Long
    
    Range("A1:B" & Rows.Count).ClearContents
    Range("A1:B1") = Array("Ürün", "Fiyat")
    
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    strURL = "https://www.hapeloglu.com/meyve-sebze?kategori=10,231,308&sayfa=1"
 
    objHTTP.Open "GET", strURL, False
    objHTTP.send

    Set HTML = CreateObject("HTMLFILE")
    HTML.body.innerHTML = objHTTP.responseText
    
    Set Divs = HTML.getElementsByTagName("div")
 
    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "productName detailUrl" Then
            iRow = iRow + 1
            Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).innerText
        End If
        If Divs(x).classname = "productPrice " Then
            Cells(iRow + 1, 2) = Replace(Divs(x).ChildNodes(0).innerText, " TL KDV Dahil", "") + 0
            Cells(iRow + 1, 2).NumberFormat = "#,##0.00"
        End If
    Next
End Sub
.
 
Son düzenleme:
Katılım
20 Ocak 2005
Mesajlar
526
Excel Vers. ve Dili
Excel 2007 Türkçe
Sub Test() ' Haluk - 10/05/2022 Dim objHTTP As Object, strURL As String Dim HTML As Object, Tables As Object, Table As Object Dim x As Integer, i As Long, iRow As Long Range("A1:B" & Rows.Count).ClearContents Range("A1:B1") = Array("Ürün", "Fiyat") Set objHTTP = CreateObject("MSXML2.XMLHTTP") strURL = "https://www.hapeloglu.com/meyve-sebze?kategori=10,231,308&sayfa=1" objHTTP.Open "GET", strURL, False objHTTP.send Set HTML = CreateObject("HTMLFILE") HTML.body.innerHTML = objHTTP.responseText Set Divs = HTML.getElementsByTagName("div") For x = 0 To Divs.Length - 1 If Divs(x).classname = "productName detailUrl" Then iRow = iRow + 1 Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).innerText End If If Divs(x).classname = "productPrice " Then Cells(iRow + 1, 2) = Replace(Divs(x).ChildNodes(0).innerText, " TL KDV Dahil", "") + 0 Cells(iRow + 1, 2).NumberFormat = "#,##0.00" End If Next End Sub
Ustadım çok teşekkürler. Bilgi ne büyük bir güç gerçekten. Paylaşmakta öyle olsa gerek. Saygılar.
 

beab05

Özel Üye
Katılım
19 Mart 2007
Mesajlar
1,366
Excel Vers. ve Dili
Office 2013
Merhaba;

Keşke her site için çalışsaydı :)

Her sitenin html kodları farklıdır ve buna göre yukarıdaki kodu siz yeni sitenin html kaynak kodlarına bakarak değiştirmeniz gerekiyor.
 

polis-53

Altın Üye
Katılım
26 Aralık 2008
Mesajlar
1,089
Excel Vers. ve Dili
EXCEL 2016 TÜRKÇE
Merhaba;

Keşke her site için çalışsaydı :)

Her sitenin html kodları farklıdır ve buna göre yukarıdaki kodu siz yeni sitenin html kaynak kodlarına bakarak değiştirmeniz gerekiyor.
ustat html kaynak kodları hangisi bilemedimki.
 

polis-53

Altın Üye
Katılım
26 Aralık 2008
Mesajlar
1,089
Excel Vers. ve Dili
EXCEL 2016 TÜRKÇE
ustat html kaynak kodları hangisi bilemedimki.
 

beab05

Özel Üye
Katılım
19 Mart 2007
Mesajlar
1,366
Excel Vers. ve Dili
Office 2013
Browserda siteyi açın F12 basın çıkacaktır.

Ya da sitede sağ klik yapıp incele derseniz de göreceksiniz.
 

polis-53

Altın Üye
Katılım
26 Aralık 2008
Mesajlar
1,089
Excel Vers. ve Dili
EXCEL 2016 TÜRKÇE
yukarıdaki konu hapeloğlunda çalışıyor imecede HTLM kaynak kodlarından dolayı çalışmıyor bunu nasıl duzeteceğimi bilmiyorum.

Sub Test()
' Haluk - 10/05/2022

Dim objHTTP As Object, strURL As String
Dim HTML As Object, Tables As Object, Table As Object
Dim x As Integer, i As Long, iRow As Long

Range("A1:B" & Rows.Count).ClearContents
Range("A1:B1") = Array("Ürün", "Fiyat")

Set objHTTP = CreateObject("MSXML2.XMLHTTP")
strURL = "https://www.imecemarket.com/meyve-sebze"

objHTTP.Open "GET", strURL, False
objHTTP.send

Set HTML = CreateObject("HTMLFILE")
HTML.body.innerHTML = objHTTP.responseText

Set Divs = HTML.getElementsByTagName("div")

For x = 0 To Divs.Length - 1
If Divs(x).classname = "productName detailUrl" Then
iRow = iRow + 1
Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).innerText
End If
If Divs(x).classname = "productPrice " Then
Cells(iRow + 1, 2) = Replace(Divs(x).ChildNodes(0).innerText, " TL KDV Dahil", "") + 0
Cells(iRow + 1, 2).NumberFormat = "#,##0.00"
End If
Next
End Sub
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,270
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
C#:
Sub Test2()
'   Haluk - 08/03/2023

    Dim objHTTP As Object, strURL As String
    Dim HTML As Object, Tables As Object, Table As Object
    Dim x As Integer, i As Long, iRow As Long
   
    Range("A1:B" & Rows.Count).ClearContents
    Range("A1:B1") = Array("Ürün", "Fiyat")
   
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    strURL = "https://www.imecemarket.com/meyve-sebze"

    objHTTP.Open "GET", strURL, False
    objHTTP.send

    Set HTML = CreateObject("HTMLFILE")
    HTML.body.innerHTML = objHTTP.responseText
   
    Set Divs = HTML.getElementsByTagName("div")

    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "product-item-container" Then
            iRow = iRow + 1
            Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).Title
        End If
        If Divs(x).classname = "price" Then
            Cells(iRow + 1, 2) = Split(Divs(x).innerText, " ")(0) + 0
            Cells(iRow + 1, 2).NumberFormat = "#,##0.00"
        End If
    Next
End Sub

.
 

polis-53

Altın Üye
Katılım
26 Aralık 2008
Mesajlar
1,089
Excel Vers. ve Dili
EXCEL 2016 TÜRKÇE
Merhaba halük bey yardımlarınız için çok teşekkür ederim.
Her sitenin html kodları farklıdır html kodunu nasıl anlayacağım
If Divs(x).classname = "product-item-container"
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,270
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Merhaba,

Eğer bu tür VBA kodlarına yatkınlığınız yoksa, burada birkaç satırla size konuyu anlatmam çok zor. Kusura bakmayın...

.
 

polis-53

Altın Üye
Katılım
26 Aralık 2008
Mesajlar
1,089
Excel Vers. ve Dili
EXCEL 2016 TÜRKÇE
Tekrar Merhaba Halük Bey Kodu çalıştırdığımda 100 den fazla gıda ürünü olmasına rağmen 21 adet gıda ürünü listeliyor
 

beab05

Özel Üye
Katılım
19 Mart 2007
Mesajlar
1,366
Excel Vers. ve Dili
Office 2013
Tekrar Merhaba Halük Bey Kodu çalıştırdığımda 100 den fazla gıda ürünü olmasına rağmen 21 adet gıda ürünü listeliyor
Çünkü ilgili sitede her sayfa ayrı bir linktir ve her sayfanın içeriğinin bir döngü içinde alınması ve ilgili kısımların listeye eklenmesi gerekiyor. Tabii bunun için de aslında ilk önce kategoriler alınmalı ve ardından ilgili kategoride kaç tane sayfa olduğu tespit edilmeli.

Örneğin;

htt ps://www.imecemarket.com/meyve-sebze?page=2

htt ps://www.imecemarket.com/meyve-sebze?page=3
.....

gibi..
 
Son düzenleme:

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,270
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Aşağıda kırmızı ile belirtilen ilaveyi yapın;


Rich (BB code):
    strURL = "https://www.imecemarket.com/meyve-sebze?limit=100"
.
 

beab05

Özel Üye
Katılım
19 Mart 2007
Mesajlar
1,366
Excel Vers. ve Dili
Office 2013
Aşağıda kırmızı ile belirtilen ilaveyi yapın;


Rich (BB code):
    strURL = "https://www.imecemarket.com/meyve-sebze?limit=100"
.
Site yapısında limit parametresi oluyorsa çözüm olabilir tabii ama ilgili sitede maximum 200 ü kabul ediyor ve 200 üzeri ürün varsa yine sayfalama gerekiyor. Gerçi soruyu soran arkadaş için tam olmasa da en uygun çözüm limitli yapması ama 200 yapsın :)
 

polis-53

Altın Üye
Katılım
26 Aralık 2008
Mesajlar
1,089
Excel Vers. ve Dili
EXCEL 2016 TÜRKÇE
teşekkür ederim şimdi oldu.
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,270
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Site yapısında limit parametresi oluyorsa çözüm olabilir tabii ama ilgili sitede maximum 200 ü kabul ediyor ve 200 üzeri ürün varsa yine sayfalama gerekiyor. Gerçi soruyu soran arkadaş için tam olmasa da en uygun çözüm limitli yapması ama 200 yapsın :)

Sayın @beab05 , aşağıdaki kod sizin için uygun olur mu?

C#:
Sub Test3()
'   Haluk - 09/03/2023

    Dim objHTTP As Object, strURL As String
    Dim HTML As Object, Tables As Object, Table As Object
    Dim x As Integer, i As Long, iRow As Long, j As Integer, iCount As Integer
   
    Range("A1:B" & Rows.Count).ClearContents
    Range("A1:B1") = Array("Ürün", "Fiyat")
   
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    strURL = "https://www.imecemarket.com/meyve-sebze"

    objHTTP.Open "GET", strURL, False
    objHTTP.send

    Set HTML = CreateObject("HTMLFILE")
    HTML.body.innerHTML = objHTTP.responseText
    
    Set Divs = HTML.getElementsByTagName("div")
    
    For x = 0 To Divs.Length - 1
        If Divs(x).classname = ("product-filter product-filter-bottom filters-panel") Then
            iCount = Split(Split(Divs(x).innerText, "(")(1), " ")(0)
        End If
    Next
    
    For j = 1 To iCount
        strURL = "https://www.imecemarket.com/meyve-sebze?page=" & j
        
        objHTTP.Open "GET", strURL, False
        objHTTP.send
    
        HTML.body.innerHTML = objHTTP.responseText
        
        Set Divs = HTML.getElementsByTagName("div")

        For x = 0 To Divs.Length - 1
            If Divs(x).classname = "product-item-container" Then
                iRow = iRow + 1
                Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).Title
            End If
            If Divs(x).classname = "price" Then
                Cells(iRow + 1, 2) = Split(Divs(x).innerText, " ")(0) + 0
                Cells(iRow + 1, 2).NumberFormat = "#,##0.00"
            End If
        Next
    Next
End Sub
.
 
Son düzenleme:

polis-53

Altın Üye
Katılım
26 Aralık 2008
Mesajlar
1,089
Excel Vers. ve Dili
EXCEL 2016 TÜRKÇE
Rica etsem bu koddada yapabilirmisiniz.



Kod:
Sub Test()
'   Haluk - 10/05/2022

    Dim objHTTP As Object, strURL As String
    Dim HTML As Object, Tables As Object, Table As Object
    Dim x As Integer, i As Long, iRow As Long
   
    Range("A1:B" & Rows.Count).ClearContents
    Range("A1:B1") = Array("Ürün", "Fiyat")
   
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    strURL = "https://www.hapeloglu.com/meyve-sebze?kategori=10,231,308&sayfa=1"

    objHTTP.Open "GET", strURL, False
    objHTTP.send

    Set HTML = CreateObject("HTMLFILE")
    HTML.body.innerHTML = objHTTP.responseText
   
    Set Divs = HTML.getElementsByTagName("div")

    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "productName detailUrl" Then
            iRow = iRow + 1
            Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).innerText
        End If
        If Divs(x).classname = "productPrice " Then
            Cells(iRow + 1, 2) = Replace(Divs(x).ChildNodes(0).innerText, " TL KDV Dahil", "") + 0
            Cells(iRow + 1, 2).NumberFormat = "#,##0.00"
        End If
    Next
End Sub
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,270
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
"Hapeloğlu" sitesinde tüm ürünler zaten tek sayfada listeleniyor, onun için gerek yok.

.
 
Üst