Dış Bağlantıdan alınan veriyi işlemek

C

crypto izmir

Katılım
2 Şubat 2021
Mesajlar
1
Excel Vers. ve Dili
2019
MErhaba Arkaşlar,

https://api.binance.com/api/v3/ticker/24hr adresinden veri alıyorum. Para birimlerinin fiyatlarını güncel olarak alıyorum.

Yapmak istediğim,

1- ) gelen fiyat verisini örneğin A1 hücresine yazıyor. Ben her gelen yeni veriyi aynı hücreye değilde a2, a3, a4 gibi aşağı dogru yazdırmak istiyorum.

2- ) Mesela B1 ve B2 de bulunan verinin yüzdesini alıp, bu yüzde sonucunu yazdığım B3 hücresinde her %1'in üzerinde bi veri aldığımda bunu 1,2,3 olarak saydırıp B4 hücresine yazdırmak istiyorum. ve B3 deki veri %0.5 in altına düştüğünde ise B4 hücresindeki sayma verisini sıfırlayıp baştan başlatmak istiyorum.
Bunu yapabilmem mümkün mü ?

Yardımlarınız için şimdiden size çok teşekkür ederim
 
ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
verdiğiniz link nedir?
Kodlarınız nedir?
 
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
Aşağıdaki kodu deneyin;

C#: 
Sub GetData()
    ' Haluk - 03/02/2021
    ' https://excelhaluk.blogspot.com/
    ' sa4truss@gmail.com
    
    Dim objHTTP As Object, strURL As String, HTMLcode As String
    Dim arrProperties()
    Dim arrPattern(1 To 21) As String
    Dim regExp As Object, xPattern As Variant
    Dim r As Integer, c As Byte
    Dim strResponse As String, intStatus As Integer, strStatus As String
    
    Range("A1:U" & Rows.Count) = ""
    
    arrProperties = Array("symbol", "priceChange", "priceChangePercent", "weightedAvgPrice", "prevClosePrice", _
                          "lastPrice", "lastQty", "bidPrice", "bidQty", "askPrice", "askQty", "openPrice", _
                          "highPrice", "lowPrice", "volume", "quoteVolume", "openTime", "closeTime", _
                          "firstId", "lastId", "count")
                          
    Range("A1:U1") = arrProperties
    Range("A1:U1").Font.Bold = True
    Range("A1:U1").Font.Color = vbRed
    
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    
    strURL = "https://api.binance.com/api/v3/ticker/24hr"
    
    objHTTP.Open "GET", strURL, False
    objHTTP.send
    
    If objHTTP.ReadyState = 4 And objHTTP.Status = 200 Then
        HTMLcode = objHTTP.responseText
        
        arrPattern(1) = """symbol"":""(.+?)"",""priceChange"":"
        arrPattern(2) = """priceChange"":""(.+?)"",""priceChangePercent"":"
        arrPattern(3) = """priceChangePercent"":""(.+?)"",""weightedAvgPrice"":"
        arrPattern(4) = """weightedAvgPrice"":""(.+?)"",""prevClosePrice"":"
        arrPattern(5) = """prevClosePrice"":""(.+?)"",""lastPrice"":"
        arrPattern(6) = """lastPrice"":""(.+?)"",""lastQty"":"
        arrPattern(7) = """lastQty"":""(.+?)"",""bidPrice"":"
        arrPattern(8) = """bidPrice"":""(.+?)"",""bidQty"":"
        arrPattern(9) = """bidQty"":""(.+?)"",""askPrice"":"
        arrPattern(10) = """askPrice"":""(.+?)"",""askQty"":"
        arrPattern(11) = """askQty"":""(.+?)"",""openPrice"":"
        arrPattern(12) = """openPrice"":""(.+?)"",""highPrice"":"
        arrPattern(13) = """highPrice"":""(.+?)"",""lowPrice"":"
        arrPattern(14) = """lowPrice"":""(.+?)"",""volume"":"
        arrPattern(15) = """volume"":""(.+?)"",""quoteVolume"":"
        arrPattern(16) = """quoteVolume"":""(.+?)"",""openTime"":"
        arrPattern(17) = """openTime"":(.+?),""closeTime"":"
        arrPattern(18) = """closeTime"":(.+?),""firstId"":"
        arrPattern(19) = """firstId"":(.+?),""lastId"":"
        arrPattern(20) = """lastId"":(.+?),""count"":"
        arrPattern(21) = """count"":(.+?)}"
        
        Set regExp = CreateObject("VBScript.RegExp")
        
        regExp.ignorecase = True
        regExp.Global = True
            
        For Each xPattern In arrPattern
            regExp.Pattern = xPattern
            r = 1
            c = c + 1
            If regExp.Test(HTMLcode) Then
                For Each RetVal In regExp.Execute(HTMLcode)
                    r = r + 1
                    Cells(r, c) = RetVal.Submatches(0)
                Next
            End If
        Next
        
        Columns("A:U").AutoFit
        MsgBox "İşlem tamam...", vbInformation
    Else
        strResponse = Split(objHTTP.responseText, "status"":")(1)
        intStatus = Split(strResponse, "}")(0) + 0
        
        strResponse = Split(objHTTP.responseText, "error"":""")(1)
        strStatus = Split(strResponse, """")(0)
        
        MsgBox "Durum: " & intStatus & vbCrLf & vbCrLf & "Hata mesajı: " & strStatus
    End If
    
    Set regExp = Nothing
    Set objHTTP = Nothing
    Erase arrPattern
End Sub
.
 
Son düzenleme:
veyselemre

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,650
Excel Vers. ve Dili
Pro Plus 2021
PowerQuery>

Kod: 
let
    Source = Json.Document(Web.Contents("https://api.binance.com/api/v3/ticker/24hr")),
    #"Converted to Table" = Table.FromList(Source, Splitter.SplitByNothing(), null, null, ExtraValues.Error),
    #"Expanded Column1" = Table.ExpandRecordColumn(#"Converted to Table", "Column1", {"symbol", "priceChange", "priceChangePercent", "weightedAvgPrice", "prevClosePrice", "lastPrice", "lastQty", "bidPrice", "bidQty", "askPrice", "askQty", "openPrice", "highPrice", "lowPrice", "volume", "quoteVolume", "openTime", "closeTime", "firstId", "lastId", "count"}, {"symbol", "priceChange", "priceChangePercent", "weightedAvgPrice", "prevClosePrice", "lastPrice", "lastQty", "bidPrice", "bidQty", "askPrice", "askQty", "openPrice", "highPrice", "lowPrice", "volume", "quoteVolume", "openTime", "closeTime", "firstId", "lastId", "count"})
in
    #"Expanded Column1"

Kod: 
let
    Source = Json.Document(Web.Contents("https://api.binance.com/api/v3/klines?symbol=BTCUSDT&interval=15m")),
    #"Converted to Table" = Table.FromList(Source, Splitter.SplitByNothing(), null, null, ExtraValues.Error),
    #"Extracted Values" = Table.TransformColumns(#"Converted to Table", {"Column1", each Text.Combine(List.Transform(_, Text.From), ","), type text}),
    #"Split Column by Delimiter" = Table.SplitColumn(#"Extracted Values", "Column1", Splitter.SplitTextByDelimiter(",", QuoteStyle.Csv), {"Column1.1", "Column1.2", "Column1.3", "Column1.4", "Column1.5", "Column1.6", "Column1.7", "Column1.8", "Column1.9", "Column1.10", "Column1.11", "Column1.12"})
in
    #"Split Column by Delimiter"
 

Ekli dosyalar

Son düzenleme:
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
3 No'lu mesajımdaki gibi yine "Regular Expressions" ile alternatif;

C#: 
Sub GetData2()
    ' Haluk - 06/02/2021
    ' https://excelhaluk.blogspot.com/
    ' sa4truss@gmail.com
   
    Dim objHTTP As Object, strURL As String, strJSon As String
    Dim arrPattern As String
    Dim regExp As Object
    Dim r As Integer, c As Byte, temp As Variant
    Dim strResponse As String, intStatus As Integer, strStatus As String
   
    Range("A1:L" & Rows.Count) = ""
   
    arrProperties = Array("Open Time", "Open", "High", "Low", "Close", _
                          "Volume", "Close Time", "Quote Asset Volume", "Number of Trades", _
                          "Base Asset Volume", "Quote Asset Volume", "")
                         
    Range("A1:L1") = arrProperties
    Range("A1:L1").Font.Bold = True
    Range("A1:L1").Font.Color = vbRed
   
    strURL = "https://api.binance.com/api/v3/klines?symbol=BTCUSDT&interval=15m"
   
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
   
    objHTTP.Open "GET", strURL, False
    objHTTP.send
   
    If objHTTP.ReadyState = 4 And objHTTP.Status = 200 Then
        strJSon = objHTTP.responseText
       
        arrPattern = "(\d+),""(\d[\d,.]*)"",""(\d[\d,.]*)"",""(\d[\d,.]*)"",""(\d[\d,.]*)"",""(\d[\d,.]*)"",(\d+),""(\d[\d,.]*)"",(\d+),""(\d[\d,.]*)"",""(\d[\d,.]*)"",""(\d+)"""
       
        Set regExp = CreateObject("VBScript.RegExp")
       
        regExp.ignorecase = True
        regExp.Global = True
           
        r = 1
       
        regExp.Pattern = arrPattern
        If regExp.Test(strJSon) Then
            For Each RetVal In regExp.Execute(strJSon)
                r = r + 1
                c = 1
                For i = 0 To RetVal.Submatches.Count - 1
                    temp = RetVal.Submatches(i)
                    If c = 1 Or c = 7 Then
                        temp = temp / 86400000 + 25569
                    End If
                    Cells(r, c) = temp
                    c = c + 1
                Next
            Next
        End If
       
        Columns("A:L").AutoFit
        MsgBox "İşlem tamam...", vbInformation
    Else
        strResponse = Split(objHTTP.responseText, "status"":")(1)
        intStatus = Split(strResponse, "}")(0) + 0
       
        strResponse = Split(objHTTP.responseText, "error"":""")(1)
        strStatus = Split(strResponse, """")(0)
       
        MsgBox "Durum: " & intStatus & vbCrLf & vbCrLf & "Hata mesajı: " & strStatus
    End If
   
    Range("A1:A501, G1:G501").NumberFormat = "dd/mm/yyyy hh:mm"
   
    Set regExp = Nothing
    Set objHTTP = Nothing
End Sub
.
 
Son düzenleme:
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
6 No'lu mesajdaki kodlar revize edilerek, A ve G sütunundaki veriler aa.gg.yy ss:dd formatında okunabilir şekle getirildi ve tablonun başlıkları ilave edildi

.
 
Son düzenleme:
veyselemre

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,650
Excel Vers. ve Dili
Pro Plus 2021
ScriptControl ile parse edilmiştir.

Kod: 
Sub test()
    Dim myData As Object, retVal As Object, statistics As Object
    Dim url$, response$, i&

    With CreateObject("MSXML2.XMLHTTP")
        url = "https://api.binance.com/api/v3/klines?symbol=BTCUSDT&interval=15m"
        .Open "GET", url, False
        .send
        response = .responseText
        .abort
    End With

    With CreateObject("MSScriptControl.ScriptControl")
        .Language = "JScript"
        Set retVal = .Eval("(" & response & ")")
    End With

    With Sheets("Sayfa1")
        .Range("A1:L" & Rows.Count) = ""
         i = 2
        For Each myData In retVal
            .Cells(i, 1).Resize(, 12).Value = Split(myData, ",")
            i = i + 1
        Next
        .Columns.AutoFit
    End With
    Set retVal = Nothing
End Sub
Kod: 
Sub test()
    Dim myData As Object, retVal As Object, statistics As Object
    Dim url$, response$, i&

    With CreateObject("MSXML2.XMLHTTP")
        url = "https://api.binance.com/api/v3/ticker/24hr"
        .Open "GET", url, False
        .send
        response = Replace(.responseText, "count", "cnt")
        .abort
    End With

    With CreateObject("MSScriptControl.ScriptControl")
        .Language = "JScript"
        Set retVal = .Eval("(" & response & ")")
    End With

    With Sheets("Sayfa1")
        .Range("A1:U" & Rows.Count) = ""
        .Range("A1:U1") = Array("symbol", "priceChange", "priceChangePercent", "weightedAvgPrice", "prevClosePrice", _
                                "lastPrice", "lastQty", "bidPrice", "bidQty", "askPrice", "askQty", "openPrice", _
                                "highPrice", "lowPrice", "volume", "quoteVolume", "openTime", "closeTime", _
                                "firstId", "lastId", "count")
        .Range("A1:U1").Font.Bold = True
        .Range("A1:U1").Font.Color = vbRed
        i = 2
        For Each myData In retVal
            .Cells(i, 1) = myData.symbol
            .Cells(i, 2) = myData.priceChange
            .Cells(i, 3) = myData.priceChangePercent
            .Cells(i, 4) = myData.weightedAvgPrice
            .Cells(i, 5) = myData.prevClosePrice
            .Cells(i, 6) = myData.lastPrice
            .Cells(i, 7) = myData.lastQty
            .Cells(i, 8) = myData.bidPrice
            .Cells(i, 9) = myData.bidQty
            .Cells(i, 10) = myData.askPrice
            .Cells(i, 11) = myData.askQty
            .Cells(i, 12) = myData.openPrice
            .Cells(i, 13) = myData.highPrice
            .Cells(i, 14) = myData.lowPrice
            .Cells(i, 15) = myData.volume
            .Cells(i, 16) = myData.quoteVolume
            .Cells(i, 17) = myData.openTime
            .Cells(i, 18) = myData.closeTime
            .Cells(i, 19) = myData.firstId
            .Cells(i, 20) = myData.lastId
            .Cells(i, 21) = myData.cnt
            i = i + 1
        Next
        .Columns.AutoFit
    End With
    Set retVal = Nothing
End Sub
 
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
@veyselemre ;

Maalesef, Excel 64 Bit "MSScriptControl.ScriptControl" nesnesini desteklemiyor...

.
 
veyselemre

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,650
Excel Vers. ve Dili
Pro Plus 2021
Haluk' Alıntı:
@veyselemre ;

Maalesef, Excel 64 Bit "MSScriptControl.ScriptControl" nesnesini desteklemiyor...

.
Genişletmek için tıkla ...
Sağlık olsun, örnek olsun diye ekledim. Dolaylı yollardan 64 bit üzerinden de çalıştırılıyormuş,
Ayrıca https://helloacm.com/quick-tutorial-to-64-bit-tablacus-scripting-control/ linkteki dll ekleyerek de ScriptControl çalıştırılıyormuş.

Yukardaki koddaki json objesinden isimle çağırmak için aşağıdaki gibi bir yöntem de varmış..

Kod: 
Sub test()

    Dim myData As Object, retVal As Object, statistics As Object
    Dim url$, response$, i&, arr()

    With CreateObject("MSXML2.XMLHTTP")
        url = "https://api.binance.com/api/v3/ticker/24hr"
        .Open "GET", url, False
        .send
        response = .responseText
        .abort
    End With

    With CreateObject("MSScriptControl.ScriptControl")
        .Language = "JScript"
        Set retVal = .Eval("(" & response & ")")
    End With

    With Sheets("Sayfa1")
        .Range("A1:U" & Rows.Count) = ""
        arr = Array("symbol", "priceChange", "priceChangePercent", "weightedAvgPrice", "prevClosePrice", _
                    "lastPrice", "lastQty", "bidPrice", "bidQty", "askPrice", "askQty", "openPrice", _
                    "highPrice", "lowPrice", "volume", "quoteVolume", "openTime", "closeTime", _
                    "firstId", "lastId", "count")
        .Range("A1:U1") = arr
        .Range("A1:U1").Font.Bold = True
        .Range("A1:U1").Font.Color = vbRed
        i = 2
        For Each myData In retVal
            For ii = 1 To 21
                .Cells(i, ii) = VBA.CallByName(myData, arr(ii - 1), VbGet)
            Next ii
            i = i + 1
        Next
        .Columns.AutoFit
    End With
    Set retVal = Nothing
End Sub
 
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
Aşağıdaki linkte de muhtelif kodlarım var, bilgi için linki aşağıda verdim;

www.mrexcel.com

VBA Macro to extract JSON data and post into cells

Hi, I'm thinking that the error is because the url is an HTTPS? I'm getting mismatch type error. I'm trying to getting the JSON data from this URL: https://min-api.cryptocompare.com/data/price?fsym=ETH&tsyms=USD This is the code i'm using: Public Sub exceljson() Dim http As Object, JSON...
www.mrexcel.com www.mrexcel.com

.
 
T

tiretwien

Katılım
19 Haziran 2014
Mesajlar
63
Excel Vers. ve Dili
Office365 ProPlus
Haluk' Alıntı:
3 No'lu mesajımdaki gibi yine "Regular Expressions" ile alternatif;

C#: 
Sub GetData2()
    ' Haluk - 06/02/2021
    ' https://excelhaluk.blogspot.com/
    ' sa4truss@gmail.com
  
    Dim objHTTP As Object, strURL As String, strJSon As String
    Dim arrPattern As String
    Dim regExp As Object
    Dim r As Integer, c As Byte, temp As Variant
    Dim strResponse As String, intStatus As Integer, strStatus As String
  
    Range("A1:L" & Rows.Count) = ""
  
    arrProperties = Array("Open Time", "Open", "High", "Low", "Close", _
                          "Volume", "Close Time", "Quote Asset Volume", "Number of Trades", _
                          "Base Asset Volume", "Quote Asset Volume", "")
                        
    Range("A1:L1") = arrProperties
    Range("A1:L1").Font.Bold = True
    Range("A1:L1").Font.Color = vbRed
  
    strURL = "https://api.binance.com/api/v3/klines?symbol=BTCUSDT&interval=15m"
  
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
  
    objHTTP.Open "GET", strURL, False
    objHTTP.send
  
    If objHTTP.ReadyState = 4 And objHTTP.Status = 200 Then
        strJSon = objHTTP.responseText
      
        arrPattern = "(\d+),""(\d[\d,.]*)"",""(\d[\d,.]*)"",""(\d[\d,.]*)"",""(\d[\d,.]*)"",""(\d[\d,.]*)"",(\d+),""(\d[\d,.]*)"",(\d+),""(\d[\d,.]*)"",""(\d[\d,.]*)"",""(\d+)"""
      
        Set regExp = CreateObject("VBScript.RegExp")
      
        regExp.ignorecase = True
        regExp.Global = True
          
        r = 1
      
        regExp.Pattern = arrPattern
        If regExp.Test(strJSon) Then
            For Each RetVal In regExp.Execute(strJSon)
                r = r + 1
                c = 1
                For i = 0 To RetVal.Submatches.Count - 1
                    temp = RetVal.Submatches(i)
                    If c = 1 Or c = 7 Then
                        temp = temp / 86400000 + 25569
                    End If
                    Cells(r, c) = temp
                    c = c + 1
                Next
            Next
        End If
      
        Columns("A:L").AutoFit
        MsgBox "İşlem tamam...", vbInformation
    Else
        strResponse = Split(objHTTP.responseText, "status"":")(1)
        intStatus = Split(strResponse, "}")(0) + 0
      
        strResponse = Split(objHTTP.responseText, "error"":""")(1)
        strStatus = Split(strResponse, """")(0)
      
        MsgBox "Durum: " & intStatus & vbCrLf & vbCrLf & "Hata mesajı: " & strStatus
    End If
  
    Range("A1:A501, G1:G501").NumberFormat = "dd/mm/yyyy hh:mm"
  
    Set regExp = Nothing
    Set objHTTP = Nothing
End Sub
.
Genişletmek için tıkla ...
@Haluk hocam elinize sağlık cok güzel ve işlevsel olmuş.
makroyu kodu görüntüle kısmından yapıstırdım ve çalıştırabildim. mumkunse bazı sorularım var.
500 satırlık sonuç verdi. bu rakamı arttırabilir miyiz ? ( cok onemli değil?)
makroyu her çalıştırdıgımda eski datayı yiyiyor. örnek ilk çektigimde tarih 1 subat 11:30 idi simdi cektigimde 1 subat 12:15
anladıgım kadarıyla son 500 ü çekiyor her çektigimde daha yeni tarih olacak.
bunun onüne geçilebilir mi ? eski datayı yemeden her basıldıgında bittigi satırdan yenisini koyabilir mi ?
 
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
Kullanılan API, 500 satırlık sonuç geri döndürmesi için yapılandırıldığı için bunun benimle veya VBA ile ilgisi yok. API'nın buna yönelik bir parametresi varsa, onu kullanmak gerekir.

Sonuçların alta alta yazılmasına devam etmek için, revize edilen kod ise aşağıdadır;

C#: 
Sub GetData3()
    ' Haluk - 06/02/2021
    ' https://excelhaluk.blogspot.com/
    ' sa4truss@gmail.com
   
    Dim objHTTP As Object, strURL As String, strJSon As String
    Dim arrPattern As String
    Dim regExp As Object
    Dim r As Integer, c As Byte, temp As Variant
    Dim strResponse As String, intStatus As Integer, strStatus As String
   
    arrProperties = Array("Open Time", "Open", "High", "Low", "Close", _
                          "Volume", "Close Time", "Quote Asset Volume", "Number of Trades", _
                          "Base Asset Volume", "Quote Asset Volume", "")
                         
    Range("A1:L1") = arrProperties
    Range("A1:L1").Font.Bold = True
    Range("A1:L1").Font.Color = vbRed
   
    strURL = "https://api.binance.com/api/v3/klines?symbol=BTCUSDT&interval=15m"
   
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
   
    objHTTP.Open "GET", strURL, False
    objHTTP.send
   
    If objHTTP.ReadyState = 4 And objHTTP.Status = 200 Then
        strJSon = objHTTP.responseText
       
        arrPattern = "(\d+),""(\d[\d,.]*)"",""(\d[\d,.]*)"",""(\d[\d,.]*)"",""(\d[\d,.]*)"",""(\d[\d,.]*)"",(\d+),""(\d[\d,.]*)"",(\d+),""(\d[\d,.]*)"",""(\d[\d,.]*)"",""(\d+)"""
       
        Set regExp = CreateObject("VBScript.RegExp")
       
        regExp.ignorecase = True
        regExp.Global = True
           
        r = Range("A" & Rows.Count).End(xlUp).Row
       
        regExp.Pattern = arrPattern
        If regExp.test(strJSon) Then
            For Each retVal In regExp.Execute(strJSon)
                r = r + 1
                c = 1
                For i = 0 To retVal.Submatches.Count - 1
                    temp = retVal.Submatches(i)
                    If c = 1 Or c = 7 Then
                        temp = temp / 86400000 + 25569
                    End If
                    Cells(r, c) = temp
                    c = c + 1
                Next
            Next
        End If
       
        Columns("A:L").AutoFit
        MsgBox "İşlem tamam...", vbInformation
    Else
        strResponse = Split(objHTTP.responseText, "status"":")(1)
        intStatus = Split(strResponse, "}")(0) + 0
       
        strResponse = Split(objHTTP.responseText, "error"":""")(1)
        strStatus = Split(strResponse, """")(0)
       
        MsgBox "Durum: " & intStatus & vbCrLf & vbCrLf & "Hata mesajı: " & strStatus
    End If
   
    Range("A2:A" & r).NumberFormat = "dd/mm/yyyy hh:mm"
    Range("G2:G" & r).NumberFormat = "dd/mm/yyyy hh:mm"
   
    Set regExp = Nothing
    Set objHTTP = Nothing
End Sub
.
 
T

tiretwien

Katılım
19 Haziran 2014
Mesajlar
63
Excel Vers. ve Dili
Office365 ProPlus
@Haluk hocam cok teşekkürler yeni deneyebildim.
cok guzel çalışıyor.
kendimce linke yükledigim dosyayı oluşturdum. her coin icin ayrı sheet yaptım ama dosyayı hazırlaması uzun suruyor
bunu nasıl kısalaştırabiliriz sizce ?

şöyle birşey olabilir mi ?
tek sayfada tüm coinleri çekebilse ,
coinleri ayırt etmek icin sembolleri ayrı bir sütünda olabilir mi ? (çekilen api sayfasında coin isminin yazmadıgının farklındayım.) ayırt etmek icin çekilen api linki yazsa yada coin ismi

asagıda olusturdugum excel dosyasını ve olmasını bekledigim sayfayı manuel yaptım.
musait zamanınızda bakabilir misiniz ?

İndir Kripto4H

Dosyayı indir Kripto4H
dosya.co
 
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
Sanırım bakamam, yeteri kadar kod var yukarıda ..... kendiniz istediğiniz gibi özelleştirebilirsiniz çünkü işin o kısmı artık JSon ve/veya RegExp ile ilgili değil....

Kolay gelsin,

.
 
S

sansli338

Katılım
24 Aralık 2016
Mesajlar
1
Excel Vers. ve Dili
2010 excel türkçe
Haluk Bey Merhaba. Excelde bir çalışma kitabında 315 adet sayfa oluşturdum. her bir para birimi için. her bir sayfaya makroları kaydettim. bu makroları her 15 dakikada aynı anda çalıştırarak bir döngü oluşturmak istiyorum. bunun için yardımcı olursanız sevinirim.
 
X

xadm103

Katılım
16 Mart 2021
Mesajlar
41
Excel Vers. ve Dili
365excel
Selamlar

https://v3.paribu.com/app/markets/chz-tl?interval=1000

https://v3.paribu.com/app/markets/rvn-tl?interval=1000

Bu linklerin içinden açılan fiyat bilgilerinin sadece ilk "Sell" yazan fiyatı bir hücreye ve ilk "Buy" fiyatı başka bir hücreye gelecek şekilde nasıl ayarlayabilirim. Linkleri Web tarayıcıda açtığımda (chrome) de fiyatlar saniyelik değişiyor. Ve bu yenilemeyi Ve excelde de refresh olacak şekilde almak mümkün mü? Bu kodları paylaşırsanız minnettar olurum.
 
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
veyselemre' Alıntı:
Sağlık olsun, örnek olsun diye ekledim. Dolaylı yollardan 64 bit üzerinden de çalıştırılıyormuş,
Ayrıca https://helloacm.com/quick-tutorial-to-64-bit-tablacus-scripting-control/ linkteki dll ekleyerek de ScriptControl çalıştırılıyormuş.
Genişletmek için tıkla ...
Harici herhangi bir DLL veya komponent kullanmadan, hem 32 hem de 64 Bit Excel'de JSon verilerinin "ScriptControl" ile Excel'e alınmasına ilişkin çalışmayı kişisel blog'umda yayınladım.

Kod anlatılmaz, yazılır...: JSon verilerini "ScriptControl" ile MS Excel'e aktarmak (VBA)

Google Sheets ve scripting için Türkçe kaynak... bazı özel konularda Excel VBA örnekleri
excelhaluk.blogspot.com excelhaluk.blogspot.com

.
 
X

xadm103

Katılım
16 Mart 2021
Mesajlar
41
Excel Vers. ve Dili
365excel
xadm103' Alıntı:
Selamlar

https://v3.paribu.com/app/markets/chz-tl?interval=1000

https://v3.paribu.com/app/markets/rvn-tl?interval=1000

Bu linklerin içinden açılan fiyat bilgilerinin sadece ilk "Sell" yazan fiyatı bir hücreye ve ilk "Buy" fiyatı başka bir hücreye gelecek şekilde nasıl ayarlayabilirim. Linkleri Web tarayıcıda açtığımda (chrome) de fiyatlar saniyelik değişiyor. Ve bu yenilemeyi Ve excelde de refresh olacak şekilde almak mümkün mü? Bu kodları paylaşırsanız minnettar olurum.
Genişletmek için tıkla ...
@Haluk hocam bu çok önemli olmasaydı rahatsız etmezdim. Mümkünse yardımcı olabilir misiniz?
 
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
Israrinizi anliyorum da, her zaman bilgisayar basinda degilim. Cogu zaman tabletten bakiyorum cunku, evde izole durumdayim.

Bilmem anlatabildim mi.....

.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst