webde tablo gibi görünen yerdeki verileri aktarma

[beab05]

Merhaba;

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

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]

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

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

 

[mekist]

biraz amatörce oldu, 2 yılı yan yana getirdim

 

[mekist]

@Haluk @beab05
Merhaba

Kodlarda çalışmayı ekteki gibi yaptım
Kullanmak isteyen olursa diye paylaşıyorum