webde tablo gibi görünen yerdeki verileri aktarma

beab05

Özel Üye
Katılım
19 Mart 2007
Mesajlar
1,400
Excel Vers. ve Dili
Office 2013
Merhaba;

Alttaki gibi kodunuzu düzenlerseniz çalışır sanırım..

Kod:
Sub GetData_JSon()
'   Haluk - 04/06/2024
'
    Dim objHTTP As Object, strURL As String, HTMLcode As String
    Dim arrHeaders()
    Dim i As Long, j As Long
    Dim tStart As Double, tEnd As Double
    Dim myMsg As String
    Dim JSon As Object, Item As Object, xCurrency As Object
    
    tStart = Timer
    
    Sheets("Mali Tablo").Range("A1:F" & Rows.Count) = ""
    
    Application.ScreenUpdating = False
    
    arrHeaders = Array("SIRA", "KALEM", "DÖNEM-1", "DÖNEM-2", "DÖNEM-3", "DÖNEM-4")
    Sheets("Mali Tablo").Range("A1:F1") = arrHeaders
    
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    
    strURL = "https://www.isyatirim.com.tr/_layouts/15/IsYatirim.Website/Common/Data.aspx/MaliTablo?companyCode=AKSA&exchange=TRY&financialGroup=XI_29&year1=2024&period1=12&year2=2024&period2=9&year3=2024&period3=6&year4=2024&period4=3.json"
    
    objHTTP.Open "GET", strURL, False
    objHTTP.send
    
    HTMLcode = objHTTP.responseText
    
    Set JSon = JsonConverter.ParseJson(HTMLcode)
    
    If Not JSon Is Nothing Then
    
        i = 1
        
         For Each xCurrency In JSon("value")
            i = i + 1
            Sheets("Mali Tablo").Range("A" & i) = xCurrency("itemCode")
            Sheets("Mali Tablo").Range("B" & i) = xCurrency("itemDescTr")
            Sheets("Mali Tablo").Range("C" & i) = xCurrency("value1")
            Sheets("Mali Tablo").Range("D" & i) = xCurrency("value2")
            Sheets("Mali Tablo").Range("E" & i) = xCurrency("value3")
            Sheets("Mali Tablo").Range("F" & i) = xCurrency("value4") + 0
        Next
    End If
        
    tEnd = Timer
    Application.ScreenUpdating = True
    
    myMsg = "Veriler " & Format(tEnd - tStart, "0.00") & " saniyede alınmıştır..."
            
    MsgBox myMsg, vbInformation, "Bilgi..."
    
    Set objHTTP = Nothing
End Sub
 

mekist

Altın Üye
Katılım
13 Ağustos 2008
Mesajlar
282
Excel Vers. ve Dili
Office 365 ProPlus-Türkçe
Altın Üyelik Bitiş Tarihi
03-10-2026
Teşekkür ederim çalıştı

Bu sorgudan AKSA firmasının 2024 verilerini almış olduk, siyah yaptığım alanları değiştirerek 2023 verilerini çekebiliyorum
  1. Şirket aynı olunca her dönemi sağa doğru yazmak mümkün mü
  2. Dönemler aynı şirket farklı olunca alta doğru yazdırmak mümkün mü
Bu arada Excel' de Power Query ile alıyorum, orda tablo güncellemesi şeklinde olduğu için verileri alması uzun sürüyor

AKSA&exchange=TRY&financialGroup=XI_29&year1=2024&period1=12&year2=2024&period2=9&year3=2024&period3=6&year4=2024&period4=3.json
252181
 

mekist

Altın Üye
Katılım
13 Ağustos 2008
Mesajlar
282
Excel Vers. ve Dili
Office 365 ProPlus-Türkçe
Altın Üyelik Bitiş Tarihi
03-10-2026
biraz amatörce oldu, 2 yılı yan yana getirdim
 

Ekli dosyalar

Üst