Güncel Market Fiyatları İnternetten Bulmak

5353 · 28 Şubat 2023

Merhaba arkadaşlar. Örneğin "https://www.hapeloglu.com/meyve-sebze?kategori=10,231,308&sayfa=1 " sayfadaki cins ve fiyat listesini Excel e aktarabilir miyiz ?

Haluk · 2 Mart 2023

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

.

5353 · 6 Mart 2023

Haluk' Alıntı:
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.

polis-53 · 8 Mart 2023

Merhaba Haluk bey
https://www.imecemarket.com/sut-kahvaltilik
vermiş olduğunuz kod imcemarket.com da çalışmıyor neden ne acaba.

beab05 · 8 Mart 2023

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 · 8 Mart 2023

beab05' Alıntı:
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 · 8 Mart 2023

ustat html kaynak kodları hangisi bilemedimki.

beab05 · 8 Mart 2023

Browserda siteyi açın F12 basın çıkacaktır.

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

polis-53 · 8 Mart 2023

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 · 8 Mart 2023

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 · 8 Mart 2023

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 · 8 Mart 2023

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 · 9 Mart 2023

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 · 9 Mart 2023

polis-53' Alıntı:
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..

Haluk · 9 Mart 2023

Aşağıda kırmızı ile belirtilen ilaveyi yapın;

Rich (BB code):

    strURL = "https://www.imecemarket.com/meyve-sebze?limit=100"

.

beab05 · 9 Mart 2023

Haluk' Alıntı:
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 · 9 Mart 2023

teşekkür ederim şimdi oldu.

Haluk · 9 Mart 2023

beab05' Alıntı:
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

.

polis-53 · 9 Mart 2023

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 · 9 Mart 2023

"Hapeloğlu" sitesinde tüm ürünler zaten tek sayfada listeleniyor, onun için gerek yok.

.

Güncel Market Fiyatları İnternetten Bulmak

5353

Haluk

Özel Üye

5353

polis-53

beab05

Özel Üye

polis-53

polis-53

beab05

Özel Üye

polis-53

Haluk

Özel Üye

polis-53

Haluk

Özel Üye

polis-53

beab05

Özel Üye

Haluk

Özel Üye

beab05

Özel Üye

polis-53

Haluk

Özel Üye

polis-53

Haluk

Özel Üye