vba ile https://marketfiyati.org.tr/ sitesinden veri çekme

walabi · Cuma saat 09:59'de

Merhaba, hayırlı ramazanlar.

https://marketfiyati.org.tr/ sitesinden vba ile direk veri çekmek mümkün müdür?Daha doğrusu veri çekebilecek vba kodu nasıl olabilir?

walabi · Pazartesi saat 18:11'de

İyi akşamlar, bu konuyla ilgili destek almam mümkün mü? Ya da yönlendirici bir cevap.

muhasebeciyiz · Dün 09:42 da

Site arayüzü büyük ihtimalle JavaScript ile veri çekiyor (HTML’yi “kopyala-yapıştır” gibi almak çoğu zaman yetmiyor
“api.marketfiyati.org.tr” gibi bir alan adı görünüyor ama şu an erişimde 404’a yönleniyor; yani “resmi, dokümante bir public API” bulmak zor.

Site veriyi çoğu zaman JS ile çektiği için “HTML al → tabloya bas” yöntemi sık bozuluyor; ayrıca kullanım koşulları tarafında da dikkatli olmak gerekiyor (bazı paylaşımlarda içerik kaldırma notları var).

walabi · Dün 09:51 da

muhasebeciyiz' Alıntı:
Site arayüzü büyük ihtimalle JavaScript ile veri çekiyor (HTML’yi “kopyala-yapıştır” gibi almak çoğu zaman yetmiyor
“api.marketfiyati.org.tr” gibi bir alan adı görünüyor ama şu an erişimde 404’a yönleniyor; yani “resmi, dokümante bir public API” bulmak zor.

Site veriyi çoğu zaman JS ile çektiği için “HTML al → tabloya bas” yöntemi sık bozuluyor; ayrıca kullanım koşulları tarafında da dikkatli olmak gerekiyor (bazı paylaşımlarda içerik kaldırma notları var).

Teşekkürler sayın @muhasebeciyiz , site alt yapısı sanırım Tübitak tarafından oluşturulmuş. Org uzantılı sitelerin veri almak için pratiklik sağlaması gerekir diye düşünerek konu açtım aslında. Ancak tam tersi gibi.

netzone · Dün 18:20 da

Merhaba @walabi

Sizin de belirttiğiniz gibi Kamunun yararına olacak bir siteden veri çekmek daha kolay olmalıydı ancak günümüz de internet ne kadar hızlı olsa da sitelerin yüklenmesini çok çok hızlı hale getirmek için bazı teknolojiler kullanmak zorundalar, belki talep ederseniz açık bir api key alabilirsiniz bunun için mail atıp şansınızı deneyebilirsiniz.

Yapay Zeka ile belki karşılaşmadığımız bir çözüm varmı diye kontrol ettiğimde; Önerilerinin sonucu hep aynı hata ile karşılaştık [hata kodu:418] bizi bot olarak görüyor.

Bunun üzerine Selenium ile de kesin çözüme ulaşılamayabileceğini belirtti ve ekledi "Ben olsam kod yazmadan Power Automate Desktop (PAD) ile verileri listelerdim" dedi.

Ne İşe Yarar?

Genişletmek için tıkla ...

marketfiyati.org.tr gibi:
API bot korumalı

418 hatası veriyor

Cloudflare var
olan sitelerde PAD şunları yapabilir:

Gerçek Edge / Chrome açar

Siteye normal kullanıcı gibi girer

Sayfaları gezer

Ürün kartlarını okur

Fiyatları çeker

Excel’e tablo olarak yazar

Cloudflare bunu bot olarak algılamaz çünkü gerçek tarayıcı kullanır.

**Eğer verilere anlık olarak erişmek değil de ara ara fiyat güncellemek ise amacınız, nispeten daha fazla zaman alacak bu çözüm yolunu kullanarak ara ara verileri liste halinde alabilirsiniz.

Excel başlat

Tarayıcıyı başlat

Sayfaya git

Ürün listesini yakala

Ürün içindeki market fiyatlarını döngü ile al

Excel’e yaz

1 den fazla sayfa varsa → sonraki sayfaya git

Son sayfada dur

İyi çalışmalar.

walabi · Dün 18:50 da

netzone' Alıntı:
Merhaba @walabi

Sizin de belirttiğiniz gibi Kamunun yararına olacak bir siteden veri çekmek daha kolay olmalıydı ancak günümüz de internet ne kadar hızlı olsa da sitelerin yüklenmesini çok çok hızlı hale getirmek için bazı teknolojiler kullanmak zorundalar, belki talep ederseniz açık bir api key alabilirsiniz bunun için mail atıp şansınızı deneyebilirsiniz.

Yapay Zeka ile belki karşılaşmadığımız bir çözüm varmı diye kontrol ettiğimde; Önerilerinin sonucu hep aynı hata ile karşılaştık [hata kodu:418] bizi bot olarak görüyor.

Bunun üzerine Selenium ile de kesin çözüme ulaşılamayabileceğini belirtti ve ekledi "Ben olsam kod yazmadan Power Automate Desktop (PAD) ile verileri listelerdim" dedi.

**Eğer verilere anlık olarak erişmek değil de ara ara fiyat güncellemek ise amacınız, nispeten daha fazla zaman alacak bu çözüm yolunu kullanarak ara ara verileri liste halinde alabilirsiniz.

Excel başlat
Tarayıcıyı başlat
Sayfaya git
Ürün listesini yakala
Ürün içindeki market fiyatlarını döngü ile al
Excel’e yaz
1 den fazla sayfa varsa → sonraki sayfaya git
Son sayfada dur

İyi çalışmalar.

İlginiz için teşekkürler, ben aslında haftalık, aylık, yıllık gibi kıyaslamalar yapabilmek için düşünmüştüm. Ancak mevcut hali ile pratik bir yol yok sanırım, teknik konularına hakim değilim, ama şu da var, 50 binden fazla ürün, ve bu ürünlerin yer aldığı çok sayıda market şubesi. excel açısından da ciddi bir yük sanırım.

Biolightant · Dün 23:54 da

Merhaba
1. https://github.com/VBA-tools/VBA-JSON linkini tarayıcınızda açın
2. açılan sayfada "JsonConverter.bas" dosyasını bilgisayarınıza ekleyiniz
3. Boş bir excel dosyası açınız
4. Excel VBE açınız (Alt+F11)
5. "JsonConverter.bas" dosyasını ekleyiniz (import file...)
6. VBE menüde > Tolls > References... >

Microsoft WinHttp Services, Version 5.1

Microsoft Scripting Runtime
seçili konuma getirip
7. excel dosyasını makrolu olarak xlsm kaydedin
8. Makrolardan UrunAra makrosunu çalıştırın

Not:
1. ilk olarak konumu TÜBİTAK merkez ENLEM ve BOYLAM mı nı alır buraya yakın market sonuçlarına bakacak
2. Kendi istediğimiz her hangi bir yerin enlem ve boylamını öğrenmek için
https://maps.google.com/ Adresinden haritada isteğiniz noktayı SAĞ tıklayın ve çıkan iki sayıyı not alın(kopyalayıp)
3. Excel menüsü > Formüller > Ad Yöneticisi tıklayın
MF_LAST_LAT (enlem değeri) ve MF_LAST_LON (boylam değeri)
https://maps.google.com/ dan aldığınız ENLEM ve BOYLAM değerlerini yazınız.

C++:

Option Explicit

' ============================================================
' MarketFiyati - Excel 2016 - Biolight 2026 - Eppur Si Muove
'    1. https://github.com/VBA-tools/VBA-JSON linkini tarayıcınızda açın
'    2. açılan sayfada "JsonConverter.bas" dosyasını bilgisayarınıza ekleyiniz
'    3. Boş bir excel dosyası açınız
'    4. Excel VBE açınız (Alt+F11)
'    5. "JsonConverter.bas" dosyasını ekleyiniz (import file...)
'    6. VBE menüde > Tolls > References... >
'    Microsoft WinHttp Services, Version 5.1
'    Print Microsoft Scripting Runtime
'    seçili konuma getirip
'    7. excel dosyasını makrolu olarak xlsm kaydedin
'    8. Makrolardan UrunAra mkarosunu çalıştırın
'
'    Not:
'    1. ilk olarak konumu TÜBİTAK merkez ENLEM ve BOYLAM mını alır buraya yakın market sonuçlarına bakacak
'    2. Kendi istediğimiz her hangi bir yerin enlem ve boylamını öğrenmek için
'    https://maps.google.com/ Adresinden haritada isteginiz noktayı SAĞ tıklayın ve çıkan iki sayıyı not alın(kopyalayıp)
'    3. Excel menüsü > Formüller > Ad Yöneticisi tıklayın
'    MF_LAST_LAT (enlem değeri) ve MF_LAST_LON (boylam değeri)
'    https://maps.google.com/ dan aldığınız ENLEM ve BOYLAM değerlerini yazınız
' ============================================================
Public Sub UrunAra()
    Dim q As String
    q = InputBox("MarketFiyati araması için ürün adı:", "Ürün Ara", "elma")
    q = Trim$(q)
    If Len(q) = 0 Then Exit Sub

    Dim lat As Double, lon As Double
    GetLatLon lat, lon          ' kayıtlı konumu oku / yoksa TÜBİTAK yaz

    Dim r As Object
    Set r = GetFirstItemInfo(q, lat, lon)
    
    ' Ürün bulunamadıysa (fonksiyon Nothing döndürdüyse) direkt çık
    If r Is Nothing Then Exit Sub

    With ThisWorkbook.Worksheets("Sayfa1")
        .Range("A1").value = "Arama"
        .Range("B1").value = r("query")

        .Range("A2").value = "Market"
        .Range("B2").value = r("market")

        .Range("A3").value = "Birim"
        .Range("B3").value = r("unit")

        .Range("A4").value = "Fiyat"
        .Range("B4").value = r("price")
        .Range("B4").NumberFormat = "0,00"
    End With

    Debug.Print r("query"), r("market"), r("unit"), r("price")
End Sub

' ============================================================
' KONUM: kayitli -> TÜBİTAK
' ============================================================

Private Sub GetLatLon(ByRef lat As Double, ByRef lon As Double)
    ' ENLEM ve BOYLAM Öğrenme
    ' https://maps.google.com/ Adresinden haritada isteginiz noktayı SAĞ tıklayın
    ' çıkan iki sayıyı kopyala.
    
    Const SAVE_LAT As Double = 39.901234   ' TÜBİTAK enlemi
    Const SAVE_LON As Double = 32.781234   ' TÜBİTAK boylamı

    Dim sLat As String, sLon As String
    sLat = GetNameText("MF_LAST_LAT", "")
    sLon = GetNameText("MF_LAST_LON", "")

    If Len(Trim$(sLat)) > 0 And Len(Trim$(sLon)) > 0 Then
        ' Kayıtlı konum var -> sessizce kullan
        lat = ParseDouble(sLat, SAVE_LAT)
        lon = ParseDouble(sLon, SAVE_LON)
    Else
        ' Kayıtlı yok -> TÜBİTAK + mesaj
'        MsgBox "Kayıtlı konum yok! TÜBİTAK konumu kullanıldı.", vbInformation
        lat = SAVE_LAT
        lon = SAVE_LON
        SaveLatLon lat, lon
    End If
End Sub

Private Sub SaveLatLon(ByVal lat As Double, ByVal lon As Double)
    SetNameText "MF_LAST_LAT", ToDot(lat)
    SetNameText "MF_LAST_LON", ToDot(lon)
End Sub

Private Function GetNameText(ByVal nm As String, ByVal defaultValue As String) As String
    Dim s As String
    On Error Resume Next
    s = ThisWorkbook.Names(nm).RefersTo
    On Error GoTo 0

    If Len(s) = 0 Then
        GetNameText = defaultValue
        Exit Function
    End If

    ' ="deger" formatını temizle
    If Left$(s, 2) = "=""" Then
        GetNameText = Mid$(s, 3, Len(s) - 3)
    ElseIf Left$(s, 1) = "=" Then
        GetNameText = Mid$(s, 2)
    Else
        GetNameText = s
    End If
End Function

Private Sub SetNameText(ByVal nm As String, ByVal value As String)
    Dim formula As String
    ' ="deger" şeklinde yazar; var ise üstüne yazar
    formula = "=""" & Replace(value, """", """""") & """"

    On Error Resume Next
    ThisWorkbook.Names(nm).RefersTo = formula
    If Err.Number <> 0 Then
        Err.Clear
        ThisWorkbook.Names.Add Name:=nm, RefersTo:=formula
    End If
    On Error GoTo 0
End Sub

Private Function ParseDouble(ByVal s As String, ByVal defaultVal As Double) As Double
    Dim t As String
    t = Trim$(s)
    If Len(t) = 0 Then
        ParseDouble = defaultVal
        Exit Function
    End If

    ' Hem virgülü hem noktayı, nokta tabanlı formata çevir
    t = Replace(t, ",", ".")
    ' Val, '.' u ondalık ayırıcı gibi yorumlar, bölgesel ayardan bağımsız
    ParseDouble = Val(t)

    ' Eğer Val herhangi bir nedenle 0 döner ve orijinal metin de "0" değilse
    If ParseDouble = 0 And t <> "0" Then
        ParseDouble = defaultVal
    End If
End Function

' ============================================================
' MarketFiyati API (XMLHTTP)
' ============================================================

Public Function GetFirstItemInfo(ByVal keywords As String, _
                                 ByVal lat As Double, _
                                 ByVal lon As Double) As Object
    Dim url As String
    url = "https://api.marketfiyati.org.tr/api/v2/search"

    Dim body As String
    body = "{""keywords"":""" & JsonEscape(keywords) & """,""latitude"":" & ToDot(lat) & _
           ",""longitude"":" & ToDot(lon) & ",""size"":24}"

    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")

    http.Open "POST", url, False

    http.setRequestHeader "Content-Type", "application/json;charset=UTF-8"
    http.setRequestHeader "Accept", "application/json, text/plain, */*"
    http.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/122.0.0.0 Safari/537.36"
    http.setRequestHeader "Origin", "https://marketfiyati.org.tr"
    http.setRequestHeader "Referer", "https://marketfiyati.org.tr/ara?q=" & UrlEncodeSimple(keywords)
    http.setRequestHeader "Accept-Language", "tr-TR,tr;q=0.9,en-US;q=0.8,en;q=0.7"

    http.send body

    If http.Status <> 200 Then
        Err.Raise vbObjectError + 1, , "HTTP " & http.Status & " - " & http.statusText & vbCrLf & Left$(http.responseText, 300)
    End If

    Dim txt As String
    txt = StripBomAndTrim(http.responseText)

    Dim json As Object
    Set json = JsonConverter.ParseJson(txt)

    Dim content As Object
    Set content = json("content")
    If content Is Nothing Or content.Count = 0 Then
        MsgBox "Arama sonucunda ürün bulunamadı.", vbInformation
        Set GetFirstItemInfo = Nothing
        Exit Function
    End If

    Dim firstProd As Object
    Set firstProd = content(1)

    Dim depots As Object
    On Error Resume Next
    Set depots = firstProd("productDepotInfoList")
    On Error GoTo 0

    If depots Is Nothing Or depots.Count = 0 Then
        Err.Raise vbObjectError + 3, , "Market/fiyat listesi bulunamadı (productDepotInfoList)."
    End If

    ' En düşük fiyatlı marketi seç
    Dim bestPrice As Double: bestPrice = 1E+99
    Dim bestMarket As String, bestUnit As String
    Dim i As Long, p As Double

    For i = 1 To depots.Count
        p = CDbl(depots(i)("price"))
        If p < bestPrice Then
            bestPrice = p
            bestMarket = CStr(depots(i)("marketAdi"))
            bestUnit = UnitFromUnitPrice(CStr(depots(i)("unitPrice")))
        End If
    Next i

    Dim result As Object
    Set result = CreateObject("Scripting.Dictionary")
    result("query") = keywords
    result("market") = UCase$(bestMarket)
    result("unit") = UCase$(bestUnit)
    result("price") = bestPrice

    Set GetFirstItemInfo = result
End Function

' ============================================================
' Yardımcı fonksiyonlar
' ============================================================

Private Function JsonEscape(ByVal s As String) As String
    JsonEscape = Replace(s, """", "\""")
End Function

Private Function ToDot(ByVal d As Double) As String
    ToDot = Replace(CStr(d), ",", ".")
End Function

Private Function UrlEncodeSimple(ByVal s As String) As String
    UrlEncodeSimple = Replace(s, " ", "%20")
End Function

Private Function StripBomAndTrim(ByVal s As String) As String
    Dim t As String
    t = s
    t = Replace(t, ChrW(&HFEFF), "")
    t = Replace(t, "ï»¿", "")
    StripBomAndTrim = Trim$(t)
End Function

Private Function UnitFromUnitPrice(ByVal s As String) As String
    Dim p As Long
    p = InStr(1, s, "/", vbTextCompare)
    If p > 0 Then
        UnitFromUnitPrice = UCase$(Trim$(Mid$(s, p + 1)))
    Else
        UnitFromUnitPrice = ""
    End If
End Function

walabi · Bugün 00:00

Biolightant' Alıntı:

Merhaba
1. https://github.com/VBA-tools/VBA-JSON linkini tarayıcınızda açın
2. açılan sayfada "JsonConverter.bas" dosyasını bilgisayarınıza ekleyiniz
3. Boş bir excel dosyası açınız
4. Excel VBE açınız (Alt+F11)
5. "JsonConverter.bas" dosyasını ekleyiniz (import file...)
6. VBE menüde > Tolls > References... >

Microsoft WinHttp Services, Version 5.1

Microsoft Scripting Runtime
seçili konuma getirip
7. excel dosyasını makrolu olarak xlsm kaydedin
8. Makrolardan UrunAra makrosunu çalıştırın

Not:
1. ilk olarak konumu TÜBİTAK merkez ENLEM ve BOYLAM mı nı alır buraya yakın market sonuçlarına bakacak
2. Kendi istediğimiz her hangi bir yerin enlem ve boylamını öğrenmek için
https://maps.google.com/ Adresinden haritada isteğiniz noktayı SAĞ tıklayın ve çıkan iki sayıyı not alın(kopyalayıp)
3. Excel menüsü > Formüller > Ad Yöneticisi tıklayın
MF_LAST_LAT (enlem değeri) ve MF_LAST_LON (boylam değeri)
https://maps.google.com/ dan aldığınız ENLEM ve BOYLAM değerlerini yazınız.

C++:

Option Explicit

' ============================================================
' MarketFiyati - Excel 2016 - Biolight 2026 - Eppur Si Muove
'    1. https://github.com/VBA-tools/VBA-JSON linkini tarayıcınızda açın
'    2. açılan sayfada "JsonConverter.bas" dosyasını bilgisayarınıza ekleyiniz
'    3. Boş bir excel dosyası açınız
'    4. Excel VBE açınız (Alt+F11)
'    5. "JsonConverter.bas" dosyasını ekleyiniz (import file...)
'    6. VBE menüde > Tolls > References... >
'    Microsoft WinHttp Services, Version 5.1
'    Print Microsoft Scripting Runtime
'    seçili konuma getirip
'    7. excel dosyasını makrolu olarak xlsm kaydedin
'    8. Makrolardan UrunAra mkarosunu çalıştırın
'
'    Not:
'    1. ilk olarak konumu TÜBİTAK merkez ENLEM ve BOYLAM mını alır buraya yakın market sonuçlarına bakacak
'    2. Kendi istediğimiz her hangi bir yerin enlem ve boylamını öğrenmek için
'    https://maps.google.com/ Adresinden haritada isteginiz noktayı SAĞ tıklayın ve çıkan iki sayıyı not alın(kopyalayıp)
'    3. Excel menüsü > Formüller > Ad Yöneticisi tıklayın
'    MF_LAST_LAT (enlem değeri) ve MF_LAST_LON (boylam değeri)
'    https://maps.google.com/ dan aldığınız ENLEM ve BOYLAM değerlerini yazınız
' ============================================================
Public Sub UrunAra()
    Dim q As String
    q = InputBox("MarketFiyati araması için ürün adı:", "Ürün Ara", "elma")
    q = Trim$(q)
    If Len(q) = 0 Then Exit Sub

    Dim lat As Double, lon As Double
    GetLatLon lat, lon          ' kayıtlı konumu oku / yoksa TÜBİTAK yaz

    Dim r As Object
    Set r = GetFirstItemInfo(q, lat, lon)
   
    ' Ürün bulunamadıysa (fonksiyon Nothing döndürdüyse) direkt çık
    If r Is Nothing Then Exit Sub

    With ThisWorkbook.Worksheets("Sayfa1")
        .Range("A1").value = "Arama"
        .Range("B1").value = r("query")

        .Range("A2").value = "Market"
        .Range("B2").value = r("market")

        .Range("A3").value = "Birim"
        .Range("B3").value = r("unit")

        .Range("A4").value = "Fiyat"
        .Range("B4").value = r("price")
        .Range("B4").NumberFormat = "0,00"
    End With

    Debug.Print r("query"), r("market"), r("unit"), r("price")
End Sub

' ============================================================
' KONUM: kayitli -> TÜBİTAK
' ============================================================

Private Sub GetLatLon(ByRef lat As Double, ByRef lon As Double)
    ' ENLEM ve BOYLAM Öğrenme
    ' https://maps.google.com/ Adresinden haritada isteginiz noktayı SAĞ tıklayın
    ' çıkan iki sayıyı kopyala.
   
    Const SAVE_LAT As Double = 39.901234   ' TÜBİTAK enlemi
    Const SAVE_LON As Double = 32.781234   ' TÜBİTAK boylamı

    Dim sLat As String, sLon As String
    sLat = GetNameText("MF_LAST_LAT", "")
    sLon = GetNameText("MF_LAST_LON", "")

    If Len(Trim$(sLat)) > 0 And Len(Trim$(sLon)) > 0 Then
        ' Kayıtlı konum var -> sessizce kullan
        lat = ParseDouble(sLat, SAVE_LAT)
        lon = ParseDouble(sLon, SAVE_LON)
    Else
        ' Kayıtlı yok -> TÜBİTAK + mesaj
'        MsgBox "Kayıtlı konum yok! TÜBİTAK konumu kullanıldı.", vbInformation
        lat = SAVE_LAT
        lon = SAVE_LON
        SaveLatLon lat, lon
    End If
End Sub

Private Sub SaveLatLon(ByVal lat As Double, ByVal lon As Double)
    SetNameText "MF_LAST_LAT", ToDot(lat)
    SetNameText "MF_LAST_LON", ToDot(lon)
End Sub

Private Function GetNameText(ByVal nm As String, ByVal defaultValue As String) As String
    Dim s As String
    On Error Resume Next
    s = ThisWorkbook.Names(nm).RefersTo
    On Error GoTo 0

    If Len(s) = 0 Then
        GetNameText = defaultValue
        Exit Function
    End If

    ' ="deger" formatını temizle
    If Left$(s, 2) = "=""" Then
        GetNameText = Mid$(s, 3, Len(s) - 3)
    ElseIf Left$(s, 1) = "=" Then
        GetNameText = Mid$(s, 2)
    Else
        GetNameText = s
    End If
End Function

Private Sub SetNameText(ByVal nm As String, ByVal value As String)
    Dim formula As String
    ' ="deger" şeklinde yazar; var ise üstüne yazar
    formula = "=""" & Replace(value, """", """""") & """"

    On Error Resume Next
    ThisWorkbook.Names(nm).RefersTo = formula
    If Err.Number <> 0 Then
        Err.Clear
        ThisWorkbook.Names.Add Name:=nm, RefersTo:=formula
    End If
    On Error GoTo 0
End Sub

Private Function ParseDouble(ByVal s As String, ByVal defaultVal As Double) As Double
    Dim t As String
    t = Trim$(s)
    If Len(t) = 0 Then
        ParseDouble = defaultVal
        Exit Function
    End If

    ' Hem virgülü hem noktayı, nokta tabanlı formata çevir
    t = Replace(t, ",", ".")
    ' Val, '.' u ondalık ayırıcı gibi yorumlar, bölgesel ayardan bağımsız
    ParseDouble = Val(t)

    ' Eğer Val herhangi bir nedenle 0 döner ve orijinal metin de "0" değilse
    If ParseDouble = 0 And t <> "0" Then
        ParseDouble = defaultVal
    End If
End Function

' ============================================================
' MarketFiyati API (XMLHTTP)
' ============================================================

Public Function GetFirstItemInfo(ByVal keywords As String, _
                                 ByVal lat As Double, _
                                 ByVal lon As Double) As Object
    Dim url As String
    url = "https://api.marketfiyati.org.tr/api/v2/search"

    Dim body As String
    body = "{""keywords"":""" & JsonEscape(keywords) & """,""latitude"":" & ToDot(lat) & _
           ",""longitude"":" & ToDot(lon) & ",""size"":24}"

    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")

    http.Open "POST", url, False

    http.setRequestHeader "Content-Type", "application/json;charset=UTF-8"
    http.setRequestHeader "Accept", "application/json, text/plain, */*"
    http.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/122.0.0.0 Safari/537.36"
    http.setRequestHeader "Origin", "https://marketfiyati.org.tr"
    http.setRequestHeader "Referer", "https://marketfiyati.org.tr/ara?q=" & UrlEncodeSimple(keywords)
    http.setRequestHeader "Accept-Language", "tr-TR,tr;q=0.9,en-US;q=0.8,en;q=0.7"

    http.send body

    If http.Status <> 200 Then
        Err.Raise vbObjectError + 1, , "HTTP " & http.Status & " - " & http.statusText & vbCrLf & Left$(http.responseText, 300)
    End If

    Dim txt As String
    txt = StripBomAndTrim(http.responseText)

    Dim json As Object
    Set json = JsonConverter.ParseJson(txt)

    Dim content As Object
    Set content = json("content")
    If content Is Nothing Or content.Count = 0 Then
        MsgBox "Arama sonucunda ürün bulunamadı.", vbInformation
        Set GetFirstItemInfo = Nothing
        Exit Function
    End If

    Dim firstProd As Object
    Set firstProd = content(1)

    Dim depots As Object
    On Error Resume Next
    Set depots = firstProd("productDepotInfoList")
    On Error GoTo 0

    If depots Is Nothing Or depots.Count = 0 Then
        Err.Raise vbObjectError + 3, , "Market/fiyat listesi bulunamadı (productDepotInfoList)."
    End If

    ' En düşük fiyatlı marketi seç
    Dim bestPrice As Double: bestPrice = 1E+99
    Dim bestMarket As String, bestUnit As String
    Dim i As Long, p As Double

    For i = 1 To depots.Count
        p = CDbl(depots(i)("price"))
        If p < bestPrice Then
            bestPrice = p
            bestMarket = CStr(depots(i)("marketAdi"))
            bestUnit = UnitFromUnitPrice(CStr(depots(i)("unitPrice")))
        End If
    Next i

    Dim result As Object
    Set result = CreateObject("Scripting.Dictionary")
    result("query") = keywords
    result("market") = UCase$(bestMarket)
    result("unit") = UCase$(bestUnit)
    result("price") = bestPrice

    Set GetFirstItemInfo = result
End Function

' ============================================================
' Yardımcı fonksiyonlar
' ============================================================

Private Function JsonEscape(ByVal s As String) As String
    JsonEscape = Replace(s, """", "\""")
End Function

Private Function ToDot(ByVal d As Double) As String
    ToDot = Replace(CStr(d), ",", ".")
End Function

Private Function UrlEncodeSimple(ByVal s As String) As String
    UrlEncodeSimple = Replace(s, " ", "%20")
End Function

Private Function StripBomAndTrim(ByVal s As String) As String
    Dim t As String
    t = s
    t = Replace(t, ChrW(&HFEFF), "")
    t = Replace(t, "ï»¿", "")
    StripBomAndTrim = Trim$(t)
End Function

Private Function UnitFromUnitPrice(ByVal s As String) As String
    Dim p As Long
    p = InStr(1, s, "/", vbTextCompare)
    If p > 0 Then
        UnitFromUnitPrice = UCase$(Trim$(Mid$(s, p + 1)))
    Else
        UnitFromUnitPrice = ""
    End If
End Function

Sayın @Biolightant , incelemeden mesaj yazayım dedim. Elinize emeğinize sağlık.

walabi · Bugün 00:48

Sayın @Biolightant , tekrardan teşekkürler, ben uygulamayı kendi bilgisayarımda çalıştırabildim. Kodlar benim için anlaması zor. Ancak dosyanın işleyişinden anladığım şu. Ürün adı girdikçe fiyatı en düşük ürünü raporlamakta. Tek bir ürün arayabiliyoruz ve raporlayabiliyoruz.

Mantığını anlamadığım için şu şekilde sormak istedim. İlgili internet sitesinden yararlanırken lokasyon seçmemiz gerekiyor sanırım. Örneğin koordinatları girdiğimizde belli bir mahalledeki ( koordinata göre ) BİR marketin tüm ürünlerini, yada belli bir mahalledeki ( koordinata göre ) tüm marketlerin tüm ürünlerini excele listeletmek mümkün olur mu acaba?

Benim amacım en düşük fiyatlı ürünü bulmaktan ziyade, belli bir lokasyondaki marketlerin bütün ürünlerini fiyatları ile listelemekti.