Güncel Market Fiyatları İnternetten Bulmak

5353 · 9 Mart 2023

Sub imece1()
' 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?limit=200"

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

5353 · 9 Mart 2023

Ucuz Bul sayfasında karşılaştırmada aynısını bulamıyor.
Hücrede benzerini bul sorununu çözmek lazım. ??

beab05 · 9 Mart 2023

Haluk' Alıntı:

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

.

Sayın @Haluk benim için uygun olup olmamasının bir önemi yok. Bunu soruyu soran arkadaşa sorun bence..

Haluk · 9 Mart 2023

Ben arkadaşa "Limit" parametreli cevap vermiştim ama siz pek beğenmemiştiniz. Onun için size sordum ...

.

beab05 · 9 Mart 2023

Haluk' Alıntı:
Ben arkadaşa "Limit" parametreli cevap vermiştim ama siz pek beğenmemiştiniz. Onun için size sordum ...

.

Uzasın istemiyorum ama limit doğru çözüm değildi, limit üstündeki veriler alınmıyordu.. Neyse boşverelim beyin fırtınası tartışması olarak kalsın

Haluk · 9 Mart 2023

Ben zaten "uzatmak" için değil, "takılmak" için yazmıştım.....

.

beab05 · 9 Mart 2023

Takılan ben oldum

Son kodu da test etmedim ama eminim her zamanki gibi harika olmuştur...

Haluk · 9 Mart 2023

Eyvallah ....

.

polis-53 · 9 Mart 2023

ama sadece 100 satır getiriyor

Haluk · 9 Mart 2023

Muhterem, ne kadar varsa o kadar getiriyor.

Daha fazlasi olsa, dukkan sizin .... de, yok maalesef.

.

beab05 · 9 Mart 2023

Limiti 200 yapın..

Maceraya devam

Hem hangi link ve kategorileri hangi kodla deniyorsunuz?

serkagkx · 9 Mart 2023

merhaba
paylaşılan kod işimi gördü ancak sitede

1 2 3 ...200 e yakın sayfa var bu sayfalardaki verileri alabilmem için nasıl bir döngü kullanmak gerekir.

beab05 · 9 Mart 2023

serkagkx' Alıntı:
merhaba
paylaşılan kod işimi gördü ancak sitede

1 2 3 ...200 e yakın sayfa var bu sayfalardaki verileri alabilmem için nasıl bir döngü kullanmak gerekir.

Merhaba;

Hangi siteyi deniyorsunuz bilmem ama olması gereken mantığı açıklamaya çalışayım.

Yine market sitesi gibi düşünelim.

1- İlk önce ana sayfa request edilir. (HTML verileri alınır)

2- Daha sonra ana kategoriler aranır. Meyve, sebze, süt ürünleri, unlu mamuller, deterjan vs..

3- Daha sonra bu ana kategori linklerine göre alt kategorileri aranır. Örneğim meyve ise elma, armut gibi alt kategoriler.

4- Daha sonra da bu alt kategorilere ait sayfa sayısı belirlenip ister sayfa seçmeli ister tümünü alacak bir döngüyle (tümünü tek seferde almayı hiç tavsiye etmem) ürünler listelenir.

Sayfa sayıları alt kategori seçimi için de geçerli olabilir örneğin 100 lerce alt kategori varsa bunun için de sayfalama yapmak gerekir.

Kategori, alt kategori seçimleri için ComboBox ya da ListBox uygun olabilir ve seçilen parametrelere göre ürünler listelenebilir.

Kod kısmına gelirsek. VBA için bu kişi ben değilim.

serkagkx · 9 Mart 2023

https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca bu sitede denedim.

Haluk Beyin kodunda örnek sayfayı html karşılığına göre yaptım fakat istediğim sonuca ulaşamadım.

beab05 · 9 Mart 2023

Merhaba;

@Haluk beyin kodunu ilgili siteye göre düzenledim. Sayfalama olayına girmedim. Kendisi isterse ekler.

Rich (BB code):

Sub Test4()

'   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")


    Set HTML = CreateObject("HTMLFILE")

    Set Divs = HTML.getElementsByTagName("div")



        strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca"

     

        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 = "showcase-title" Then

                iRow = iRow + 1

                Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).Title

            End If

            If Divs(x).classname = "showcase-price" Then

                Cells(iRow + 1, 2) = Split(Divs(x).innerText, " ")(0) + 0

                Cells(iRow + 1, 2).NumberFormat = "#,##0.00"

            End If

        Next

End Sub

serkagkx · 9 Mart 2023

çok teşekkür ederim ancak dediğim gibi tek sayfa değilde kaç adet sayfa varsa o kadar sayfayı dolaşıpda verileri almak tam çözümüm olacaktır.
@Haluk Bey destek olabilirmisiniz acaba

Haluk · 9 Mart 2023

C#:

Sub Test5()
' 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")

Set HTML = CreateObject("HTMLFILE")

strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca"

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 = ("record-count text-right mt-3 mb-3") Then
        iCount = Split(Divs(x).innerText, " ")(1) \ 30 + 1
    End If
Next

For j = 1 To iCount
    strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca?tp=" & 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 = "showcase-title" Then
            iRow = iRow + 1
            Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).Title
        End If
        If Divs(x).classname = "showcase-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

.

serkagkx · 9 Mart 2023

Çok teşekkür ederim.

C#:

Sub Test5()
' 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")

Set HTML = CreateObject("HTMLFILE")

strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca"

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 = ("record-count text-right mt-3 mb-3") Then
        iCount = Split(Divs(x).innerText, " ")(1) \ 30 + 1
    End If
Next

For j = 1 To iCount
    strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca?tp=" & 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 = "showcase-title" Then
            iRow = iRow + 1
            Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).Title
        End If
        If Divs(x).classname = "showcase-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

.
[/QUOTE]
teş

serkagkx · 9 Mart 2023

@Haluk hocam son olarak ürünlerin açıklamasınıda çekebilir miyiz acaba?

beab05 · 9 Mart 2023

serkagkx' Alıntı:
@Haluk hocam son olarak ürünlerin açıklamasınıda çekebilir miyiz acaba?

Ben resimleri istersiniz diye bekliyordum

Güncel Market Fiyatları İnternetten Bulmak

5353

5353

Ekli dosyalar

beab05

Özel Üye

Haluk

𐱅𐰇𐰼𐰚

beab05

Özel Üye

Haluk

𐱅𐰇𐰼𐰚

beab05

Özel Üye

Haluk

𐱅𐰇𐰼𐰚

polis-53

Haluk

𐱅𐰇𐰼𐰚

beab05

Özel Üye

serkagkx

beab05

Özel Üye

serkagkx

beab05

Özel Üye

serkagkx

Haluk

𐱅𐰇𐰼𐰚

serkagkx

serkagkx

beab05

Özel Üye