TKGM den koordinat almak

[Tevfik_Kursun]

Merhaba Arkadaşlar,
Excel'de
A sütununda mahalleID leri 139070 gibi
B sütununda ada 389 gibi
C sütununda parsel değerleri var 26 gibi
Tapu Kadastro Genel Müdürlüğü adresinden

Chrome da https://cbsapi.tkgm.gov.tr/megsiswebapi.v3/api/parsel/139070/389/26 yazıp Enter'e bastığınızda

{"type":"Feature","geometry":{"type":"Polygon","coordinates":[[[30.12993,37.75737],[30.13,37.75765],[30.12968,37.7578],[30.12966,37.75792],[30.12952,37.75803],[30.12931,37.75778],[30.12905,37.75753],[30.12893,37.75744],[30.12909,37.75732],[30.12923,37.75721],[30.12912,37.75709],[30.12891,37.75685],[30.12907,37.75678],[30.12919,37.75676],[30.12941,37.75665],[30.12955,37.75689],[30.12974,37.75712],[30.12993,37.75737]]]},"properties":{"ilceAd":"Merkez","mevkii":"Koryakasi","ilId":37,"durum":"1","ilceId":277,"zeminKmdurum":"Ana Taşınmaz","parselNo":"26","mahalleAd":"Ilyas","ozet":"Ilyas-389/26","gittigiParselListe":"","gittigiParselSebep":"","alan":"7,722.87","adaNo":"389","nitelik":"Tarla","ilAd":"Burdur","mahalleId":139070,"pafta":"M24a23c4a"}}

geliyor. Buradaki ilk koordinat değerlerini
E sütununa 37.75737
F sütununa 30.12993 olarak almak istiyorum. Yardımcı olursanız çok makbule geçer.
Saygılarımla

 

[dEdE]

Merhaba,
Dener misiniz?

Sub Test()
    Range("F1") = Mid(Range("A1"), InStr(Range("A1"), "[") + 3, 8)
    Range("E1") = Mid(Range("A1"), InStr(Range("A1"), "[") + 12, 8)
End Sub

 

[Tevfik_Kursun]

Sayın dEdE,
{"type":"Feature","geometry":{"type":"Polygon","coordinates":[[[30.12993,37.75737],[30.13,37.75765],[30.12968,37.7578],[30.12966,37.75792],[30.12952,37.75803],[30.12931,37.75778],[30.12905,37.75753],[30.12893,37.75744],[30.12909,37.75732],[30.12923,37.75721],[30.12912,37.75709],[30.12891,37.75685],[30.12907,37.75678],[30.12919,37.75676],[30.12941,37.75665],[30.12955,37.75689],[30.12974,37.75712],[30.12993,37.75737]]]},"properties":{"ilceAd":"Merkez","mevkii":"Koryakasi","ilId":37,"durum":"1","ilceId":277,"zeminKmdurum":"Ana Taşınmaz","parselNo":"26","mahalleAd":"Ilyas","ozet":"Ilyas-389/26","gittigiParselListe":"","gittigiParselSebep":"","alan":"7,722.87","adaNo":"389","nitelik":"Tarla","ilAd":"Burdur","mahalleId":139070,"pafta":"M24a23c4a"}}
Sanırım örneğe bakmamışsınız. Önce bu değerlerin Excel'e inmesi lazım.
Yine de ilginize teşekkür ederim.
Saygılarımla

 

[veyselemre]

Sub parselBilgileriniAl()
    Dim url$, endPoint$, i%
    Range("D1:E" & Rows.Count).ClearContents
    url = "https://cbsapi.tkgm.gov.tr/megsiswebapi.v3/api/parsel/"
    With CreateObject("MSXML2.XMLHTTP")
        For i = 2 To Cells(Rows.Count, 1).End(3).Row
            endPoint = Cells(i, 1).Value & "/" & Cells(i, 2).Value & "/" & Cells(i, 3).Value
            .Open "GET", url & endPoint, False
            .send
            If .Status = 200 Then
                Cells(i, 4).Resize(, 2).Value = Split(Split(Split(.responseText, "[[[")(1), "]")(0), ",")
            End If
        Next i
    End With
End Sub

 

[Tevfik_Kursun]

Sayın Veysel Emre Hocam,
İlginize çok teşekkür ederim. Alan değerini de almak mümkün mü, lütfen?
Saygılarımla

 

[veyselemre]

Sub parselBilgileriniAl()
    Dim url$, endPoint$, i%
    Range("D1:E" & Rows.Count).ClearContents
    url = "https://cbsapi.tkgm.gov.tr/megsiswebapi.v3/api/parsel/"
    With CreateObject("MSXML2.XMLHTTP")
        For i = 2 To Cells(Rows.Count, 1).End(3).Row
            endPoint = Cells(i, 1).Value & "/" & Cells(i, 2).Value & "/" & Cells(i, 3).Value
            .Open "GET", url & endPoint, False
            .send
            If .Status = 200 Then
                Cells(i, 4).Resize(, 2).Value = Split(Split(Split(.responseText, "[[[")(1), "]")(0), ",")
                Cells(i, 6).Value = Split(Split(.responseText, "alan"":""")(1), """")(0)
            End If
        Next i
    End With
End Sub

 

[Tevfik_Kursun]

Sayın Veysel Emre Hocam,
İlginize çok çok teşekkür ederim. Çok makbule geçti.
Saygılarımla

 

[Haluk]

"JSon Parser" ile alternatif;

Sub Test()
'   Haluk - 27/03/2024
    Dim NoA As Long, i As Long, HTTP As Object, JSon As Object
  
    NoA = Range("A" & Rows.Count).End(xlUp).Row
  
    Set HTTP = CreateObject("MSXML2.XMLHTTP")
  
    For i = 2 To NoA
        HTTP.Open "GET", "https://cbsapi.tkgm.gov.tr/megsiswebapi.v3/api/parsel/" & Range("A" & i) & "/" & Range("B" & i) & "/" & Range("C" & i) & "/", False
  
        HTTP.send
      
        If HTTP.Status = 200 Then
            Set JSon = ParseJson("[" & HTTP.responseText & "]")
      
            Range("D" & i) = JSon(1)("geometry")("coordinates")(1)(1)(1)
            Range("E" & i) = JSon(1)("geometry")("coordinates")(1)(1)(2)
            Range("F" & i) = JSon(1)("properties")("alan")
        End If
    Next
    Set HTTP = Nothing
End Sub

GitHub - VBA-tools/VBA-JSON: JSON conversion and parsing for VBA

.

 

[Tevfik_Kursun]

Sayın Haluk Hocam,
İlginize çok teşekkür ederim.
Saygılarımla