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

walabi · 20 Şubat 2026

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 · 23 Şubat 2026

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

muhasebeciyiz · 24 Şubat 2026

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 · 24 Şubat 2026

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 · 24 Şubat 2026

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 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 varolan 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 · 24 Şubat 2026

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 · 24 Şubat 2026

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.904672   ' TÜBİTAK enlemi
    Const SAVE_LON As Double = 32.858655   ' 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 · 25 Şubat 2026

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 · 25 Şubat 2026

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.

Biolightant · 25 Şubat 2026

Merhaba,

İlk mesajınızdaki,

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

sorunuza cevap olarak, bir siteden veri çekme mantığını göstermek ve forumdaki arkadaşlara da örnek olması açısından bir VBA kodu paylaştım. Yani kabaca “kapıyı araladım”.

Kodlar şu an herkesin kullanımına açık; isteyen alıp kendi ihtiyacına göre geliştirebilir.

walabi' Alıntı:
BİR marketin tüm ürünlerini, ya da belli bir mahalledeki (koordinata göre) tüm marketlerin tüm ürünlerini Excele listeletmek

Ben şu aşamada bu yönde (tüm ürünler / tüm marketler) ek geliştirme yapmayı düşünmüyorum. İsteyen arkadaşlar veya siz, paylaştığım kodu temel alıp kendi ihtiyaçlarınız doğrultusunda araştırma yaparak geliştirebilirsiniz.

İyi çalışmalar.

walabi · 25 Şubat 2026

Biolightant' Alıntı:
Merhaba,

İlk mesajınızdaki,

sorunuza cevap olarak, bir siteden veri çekme mantığını göstermek ve forumdaki arkadaşlara da örnek olması açısından bir VBA kodu paylaştım. Yani kabaca “kapıyı araladım”.

Kodlar şu an herkesin kullanımına açık; isteyen alıp kendi ihtiyacına göre geliştirebilir.

Ben şu aşamada bu yönde (tüm ürünler / tüm marketler) ek geliştirme yapmayı düşünmüyorum. İsteyen arkadaşlar veya siz, paylaştığım kodu temel alıp kendi ihtiyaçlarınız doğrultusunda araştırma yaparak geliştirebilirsiniz.

İyi çalışmalar.

Sayın @Biolightant teşekkürler, yazdığınız mesajdan bunların da mümkün olduğunu anlıyorum. Bu da gayet yeterli. Balık tutmayı öğrenmemiz gerekiyor.

Elinize emeğinize sağlık tekrardan

halit3 · 25 Şubat 2026

Teşekkürler Kodlar açık kaynaklı olunca birazcık kurcaladık

Kod:

Public Sub Urunbul()
Dim q As String
Dim i, k, sat
On Error Resume Next

'Columns("A:D").ClearContents


Worksheets(ActiveSheet.Name).Cells(1, 1).value = "Arama"
Worksheets(ActiveSheet.Name).Cells(1, 2).value = "Market"
Worksheets(ActiveSheet.Name).Cells(1, 3).value = "Birim"
Worksheets(ActiveSheet.Name).Cells(1, 4).value = "Fiyat"
Worksheets(ActiveSheet.Name).Cells(1, 4).NumberFormat = "0,00"


sat = Worksheets(ActiveSheet.Name).Cells(Rows.Count, 1).End(3).Row + 1
For k = 1 To Worksheets(ActiveSheet.Name).Cells(Rows.Count, 11).End(3).Row

q = Worksheets(ActiveSheet.Name).Cells(k, 11).value

q = Trim$(q)
If Len(q) = 0 Then Exit Sub
Dim lat As Double, lon As Double
GetLatLon lat, lon

Dim r As Object
Set r = GetFirstItemInfo(q, lat, lon)

Worksheets(ActiveSheet.Name).Cells(sat, 1).value = "Bu ürün bulunamadı"
Worksheets(ActiveSheet.Name).Cells(sat, 5).value = Date

If r Is Nothing Then

Else
With ThisWorkbook.Worksheets(ActiveSheet.Name)

.Cells(sat, 1).value = r("query")
.Cells(sat, 2).value = r("market")
.Cells(sat, 3).value = r("unit")
.Cells(sat, 4).value = r("price")
.Cells(sat, 4).NumberFormat = "0,00"
End With
End If
sat = sat + 1
Debug.Print r("query"), r("market"), r("unit"), r("price")

Next k
MsgBox "işlem tamam"
End Sub

walabi · 25 Şubat 2026

Sayın @halit3 teşekkürler,

Özellikle Satınalma ile ilgilenen çalışanları ilgilendiren bir konu başlığı oldu sanırım.

halit3 · 25 Şubat 2026

dosyada güncelleme yaptım enlem ve boylamıda sayfaya aldım.

nafis · 25 Şubat 2026

halit3' Alıntı:
dosyada güncelleme yaptım enlem ve boylamıda sayfaya aldım.

Sayın @halit3 elinize sağlık. Dosyayı indirebilmemiz için; harici paylaşım yapıbilimisiniz?
Saygılarımla.

mekist · 25 Şubat 2026

@Biolightant emeğiniz için teşekkür ederim
@halit3 emeğiniz için teşekkür ederim

mekist · 26 Şubat 2026

@halit3 hocam merhaba

bu alanda anladığım kadarıyla en düşük fiyatı alıyoruz, o ürününe ait tüm market fiyatlarını almak için ne yapmak lazım

Kod:

    ' 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

halit3 · 26 Şubat 2026

dosya güncellendi bütün enlem ve boylamlar dahil edildi

muhasebeciyiz · 26 Şubat 2026

halit3 hocam
küçük ilçelerde carefour yok ama koordinat girsekde varmış gibi onuda getirmektedir
Market listelemek için data kısmına liste ve mesafede konulabilir

netzone · 26 Şubat 2026

Sitenin amacı çevredeki marketlerin fiyatlarını karşılaştırıp seçim yaptığınız marketler içinden en ucuz fiyatlı olanını göstermesidir. Koordinat seçildiğinde çevredeki marketler ve şubeleri ayrı ayrı göstermekte bunlardan birini seçtiğimizde başka markette ucuz da olsa sadece o marketteki fiyatları görürsünüz.
Arama kutusuna elma yazdığınızda *seçtiğiniz konum ve marketlere ait gönderilen istek buna benzer şekilde olacaktır.

Kod:

{"keywords":"elma","pages":0,"size":24,"latitude":39.76670183602516,"longitude":30.525945202191618,"distance":1,"depots":["migros-9534","a101-8327","carrefour-3236","a101-7766","sok-8303","a101-F811","migros-8052","a101-D436","bim-D782","a101-E497","tarim_kredi-5713","bim-5347","sok-8800","sok-1556","bim-8565","bim-5344","tarim_kredi-5140","sok-10388","sok-8686","bim-5484","tarim_kredi-5013","tarim_kredi-5089","migros-6146"]}

Siz sadece migros-9534 olarak adlandırılmış şubeyi seçtiğinizde ise bu şekilde bir istek gönderecektir.

Kod:

{"keywords":"elma","pages":0,"size":24,"latitude":39.76670183602516,"longitude":30.525945202191618,"distance":1,"depots":["migros-9534"]}

Arkadaşlarımızın vermiş olduğu kodlarda gelen verilerden sadece [content] 0.değerden veri getirmekte. Aranan "elma" sonucu birçok farklı ürün ortaya çıkmakta. Bu durumda fiyata göre artan sıralama yaptırılmadığından olmaz ama "elma" araması yaptığımızda "elmalı soda" ilk ürün kartına gelseydi 10 TL olarak fiyatını listemizde görecektik.

Maalesef ben kodlara hakim biri değilim denemelerimde sürekli bot olarak algılandığımdan çözüme de ulaşamadım. Marketlerin tüm ürünlerini almak için çalışmayı genişletecek arkadaşlara fayda sağlayabileceği düşüncesiyle; Mümkün ise şu şekilde mümkün olabilir diyerek..

- Koordinat girilir veya seçilir (latitude, longitude)
- Kapsama alanı km cinsinden belirtilir (distance)
- Makro marketleri almak için çalıştırılır
- "offer_depot" dan gelen yakındaki market verileri bir döngü ile satırlara yazdırılır, yanına bir onay kutusu yerleştirerek tüm ürünlerin fiyatlarını almak istedikleri market/şube seçilir.

-Makro ürünleri almak için çalıştırılır
* Marketteki tüm ürünleri istediğimiz için liste yapıp birebir isimlerini tam olarak aratsak bile stoklarına giren yeni ürünleri hiçbir zaman görülemeyecek. Arama kısmını kullanmak yerine ana kategorilerden yola çıkmak gerekir.

- https://marketfiyati.org.tr/ara?q=elma yerine https://marketfiyati.org.tr/kategori/meyve-ve-sebze olarak sayfayı çağırmak gerekir.
- Ana kategoriler yeterli olacaktır, bunlar: {meyve-ve-sebze, et-tavuk-ve-balik, sut-urunleri-ve-kahvaltilik, temel-gida, icecek, atistirmalik-ve-tatli, temizlik-ve-kisisel-bakim-urunleri}
- Kategori getirmek için API:

https://api.marketfiyati.org.tr/api/v2/search

yerine

https://api.marketfiyati.org.tr/api/v2/searchByCategories

kullanarak kategori sayfaları sırasıyla çağırılır. Gelen "content" içerikleri tabloya aktarılır.

**Kategori çağrıldığında örnek istek:

Kod:

{"menuCategory":true,"keywords":"Meyve ve Sebze","pages":0,"size":24,"latitude":39.76670183602516,"longitude":30.525945202191618,"distance":1,"depots":["migros-9534"]}

*Gelen veriler 24 er gelmekte, gönderilen istekte "size":24 olarak tanımlı gidiyor, bunu arttırdığımızda (örneğin 20 sayfalık bir kategori içeriği için 480 ürün kartı) değişiklik olmaz ise; pages":0 kısmını veriler arasında bulunan öğe sayısını (NumberOfFound) 24'lü kaç sayfa oluşturacağını hesaplatıp sayfa değiştirmeyi döngüye sokup istek göndererek yeni sayfadan gelen içerikleri de tablomuza ekletmeliyiz.

İyi çalışmalar.

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

walabi

walabi

muhasebeciyiz

walabi

netzone

walabi

Biolightant

walabi

walabi

Biolightant

walabi

halit3

Uzman

walabi

halit3

Uzman

nafis

mekist

mekist

halit3

Uzman

Ekli dosyalar

muhasebeciyiz

netzone