Webden veri alırken hücredeki bir önceki değeri nasıl alırım acaba?

[birdhane]

Merhaba arkadaşlar,
Excel 2016 kullanıyorum. Webden veri al özelliğiyle verileri alıyorum. dakikada bir verileri yeniliyorum. Verileri yenilemeden önce hücrede bulunan önceki veriyle karşılaştırma yapmak istiyorum da o veriye nasıl ulaşırım bulamadım, Veriler yenilenmeden önce eski veriyle karşılaştırmayı nasıl yaparım acaba?

 

[klop01]

Yukarıdaki görseldeki ilgili yerler belki işe yarayabilir.

 

[birdhane]

Ekli dosyayı görüntüle 217772

Yukarıdaki görseldeki ilgili yerler belki işe yarayabilir.

Ne yazık ki tüm seçenekleri denedim ama önceki verinin üstüne yazıyor

 

[birdhane]

Bu konuda yardımcı olabilecek arkadaş var mı acaba?

 

[muratboz06]

Örnek dosya paylaşırsanız makro ile çözüm üretilebilir.

 

[birdhane]

Örnek dosya paylaşırsanız makro ile çözüm üretilebilir.

Dosya ektedir. Bu dosyada veriler dakikada bir güncelleniyor. Bana lazım olan şey her zaman bir önceki verinin yeni güncelenen veriyi karşılaştırmak istiyorum. Ama veri yenilenince eski verinin üstüne yazdığı için bunu yapamıyorum. Yardımlarınız için teşekkürler.

 

[Korhan Ayhan]

Sayfa olaylarında TableUpdate eklenmiş. Ben ofis 2010'da göremedim.

Siz bir kontrol eder misiniz? Sizde var mı?

 

[YUSUF44]

Sayfa olaylarında TableUpdate eklenmiş. Ben ofis 2010'da göremedim.

Siz bir kontrol eder misiniz? Sizde var mı?

Aşağıdaki kodu denedim ama verileri aktarmadı. Muhtemelen Target ile Tabloyu birbiriyle eşleştirmede hata var ama herhangi bir hata da vermiyor:

Private Sub Worksheet_TableUpdate(ByVal Target As TableObject)
    If Intersect(Target, "BTCTURK_TRY") Is Nothing Then Exit Sub
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("kur")
    yeni = s1.Cells(Rows.Count, "A").End(3).Row + 1
    s1.Cells(yeni, "A") = [A2]
    s1.Cells(yeni, "B") = [B2]
    s1.Cells(yeni, "C") = [C2]
    s1.Cells(yeni, "D") = Now
End Sub

 

[birdhane]

Sayfa olaylarında TableUpdate eklenmiş. Ben ofis 2010'da göremedim.

Siz bir kontrol eder misiniz? Sizde var mı?

Kur sayfasında herhangi bir veri içeren hücre işaretliyken Veri Sekmesinde- Özellikler bölümü tıklanınca Tablo Yenileme seçenekleri veriyor. Ben ordan ayarladım. Dakika da bir verileri güncelliyor.

 

[birdhane]

Aşağıdaki kodu denedim ama verileri aktarmadı. Muhtemelen Target ile Tabloyu birbiriyle eşleştirmede hata var ama herhangi bir hata da vermiyor:

Private Sub Worksheet_TableUpdate(ByVal Target As TableObject)
    If Intersect(Target, "BTCTURK_TRY") Is Nothing Then Exit Sub
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("kur")
    yeni = s1.Cells(Rows.Count, "A").End(3).Row + 1
    s1.Cells(yeni, "A") = [A2]
    s1.Cells(yeni, "B") = [B2]
    s1.Cells(yeni, "C") = [C2]
    s1.Cells(yeni, "D") = Now
End Sub

VBA ile JSON dosyasından veri almayı beceremediğim için Excelin Veri Sekmesinde Webden Al özelliğini kullanarak verileri alıyorum. Bahsettiğiniz Target ile Tabloyu birbiriyle eşleştirmede hata var şeklinde ifade ettiğiniz hata bundan kaynaklanıyor olabilir mi

 

[YUSUF44]

VBA ile JSON dosyasından veri almayı beceremediğim için Excelin Veri Sekmesinde Webden Al özelliğini kullanarak verileri alıyorum. Bahsettiğiniz Target ile Tabloyu birbiriyle eşleştirmede hata var şeklinde ifade ettiğiniz hata bundan kaynaklanıyor olabilir mi

Fikrim yok, Korhan Bey'in önerdiği çözümü kullanabilir miyim diye uğraşmıştım ama beceremedim maalesef.

 

[birdhane]

Fikrim yok, Korhan Bey'in önerdiği çözümü kullanabilir miyim diye uğraşmıştım ama beceremedim maalesef.

Teşekkürler hocam

 

[Haluk]

JSon için hangi linki kullanıyorsunuz?

Bunu mu?

https://api.btcturk.com/api/v2/ticker

.

 

[birdhane]

JSon için hangi linki kullanıyorsunuz?

Bunu mu?

https://api.btcturk.com/api/v2/ticker

.

evet

 

[muratboz06]

Dosyanızı dosya.co sitesine yükleyip link paylaşırmısınız.

 

[Haluk]

Sub GetData_RegExp()
    ' Haluk - 14/05/2020
    'sa4truss@gmail.com
    '
    Dim objHTTP As Object, strURL As String, HTMLcode As String
    Dim arrProperties()
    Dim arrPattern(1 To 12) As String
    Dim regExp As Object, valDoviz As Variant
    Dim r As Byte, c As Byte
    Dim tstart As Double, tEnd As Double
    Dim myMsg As String
    
    tstart = Timer
    
    Range("A1:L" & Rows.Count) = ""
    
    arrProperties = Array("pairNormalized", "timestamp", "last", "high", "low", _
                          "bid", "ask", "open", "volume", "average", "daily", "dailyPercent")
                          
    Range("A1:L1") = arrProperties
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    
    strURL = "https://api.btcturk.com/api/v2/ticker"
    
    objHTTP.Open "GET", strURL, False
    objHTTP.send
    
    HTMLcode = objHTTP.responseText
    
    arrPattern(1) = """pairNormalized"":""(.+?)"",""timestamp"":"
    arrPattern(2) = """timestamp"":(.+?),""last"":"
    arrPattern(3) = """last"":(.+?),""high"":"
    arrPattern(4) = """high"":(.+?),""low"":"
    arrPattern(5) = """low"":(.+?),""bid"":"
    arrPattern(6) = """bid"":(.+?),""ask"":"
    arrPattern(7) = """ask"":(.+?),""open"":"
    arrPattern(8) = """open"":(.+?),""volume"":"
    arrPattern(9) = """volume"":(.+?),""average"":"
    arrPattern(10) = """average"":(.+?),""daily"":"
    arrPattern(11) = """daily"":(.+?),""dailyPercent"":"
    arrPattern(12) = """dailyPercent"":(.+?),""denominatorSymbol"":"
    
    Set regExp = CreateObject("VBScript.RegExp")
    
    regExp.ignorecase = True
    regExp.Global = True
        
    For Each valDoviz In arrPattern
        regExp.Pattern = valDoviz
        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
    
    tEnd = Timer
    
    myMsg = "Veriler BTC Turk'den " & Format(tEnd - tstart, "0.00") & " saniye sürede alınmıştır..." & _
            vbCrLf & vbCrLf & _
            "Not: gereksiz sıklıkta sorgulama yapmayın....IP'niz yasaklanabilir!"
            
    MsgBox myMsg, vbInformation, "Bilgi..."
    
    Set regExp = Nothing
    Set objHTTP = Nothing
    Erase arrPattern
End Sub

.

 

[birdhane]

Sub GetData_RegExp()
    ' Haluk - 14/05/2020
    'sa4truss@gmail.com
    '
    Dim objHTTP As Object, strURL As String, HTMLcode As String
    Dim arrProperties()
    Dim arrPattern(1 To 12) As String
    Dim regExp As Object, valDoviz As Variant
    Dim r As Byte, c As Byte
    Dim tstart As Double, tEnd As Double
    Dim myMsg As String
  
    tstart = Timer
  
    Range("A1:L" & Rows.Count) = ""
  
    arrProperties = Array("pairNormalized", "timestamp", "last", "high", "low", _
                          "bid", "ask", "open", "volume", "average", "daily", "dailyPercent")
                        
    Range("A1:L1") = arrProperties
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
  
    strURL = "https://api.btcturk.com/api/v2/ticker"
  
    objHTTP.Open "GET", strURL, False
    objHTTP.send
  
    HTMLcode = objHTTP.responseText
  
    arrPattern(1) = """pairNormalized"":""(.+?)"",""timestamp"":"
    arrPattern(2) = """timestamp"":(.+?),""last"":"
    arrPattern(3) = """last"":(.+?),""high"":"
    arrPattern(4) = """high"":(.+?),""low"":"
    arrPattern(5) = """low"":(.+?),""bid"":"
    arrPattern(6) = """bid"":(.+?),""ask"":"
    arrPattern(7) = """ask"":(.+?),""open"":"
    arrPattern(8) = """open"":(.+?),""volume"":"
    arrPattern(9) = """volume"":(.+?),""average"":"
    arrPattern(10) = """average"":(.+?),""daily"":"
    arrPattern(11) = """daily"":(.+?),""dailyPercent"":"
    arrPattern(12) = """dailyPercent"":(.+?),""denominatorSymbol"":"
  
    Set regExp = CreateObject("VBScript.RegExp")
  
    regExp.ignorecase = True
    regExp.Global = True
      
    For Each valDoviz In arrPattern
        regExp.Pattern = valDoviz
        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
  
    tEnd = Timer
  
    myMsg = "Veriler BTC Turk'den " & Format(tEnd - tstart, "0.00") & " saniye sürede alınmıştır..." & _
            vbCrLf & vbCrLf & _
            "Not: gereksiz sıklıkta sorgulama yapmayın....IP'niz yasaklanabilir!"
          
    MsgBox myMsg, vbInformation, "Bilgi..."
  
    Set regExp = Nothing
    Set objHTTP = Nothing
    Erase arrPattern
End Sub

.

teşekkürler hocam. Bu kodu olduğu gibi sayfanın kod kısmına yapıştırdım ama çalışmadı. Neyi eksik yaptım acaba? Hocam ayrıca Bilgi mesajında sık sorgulama yapmayın diye yazmışsınız ben uzun zamandır dakikada bir bu veriyi alıyorum sorun yaşamadım. sizce bu kod sorun yaratır mı?

 

[Haluk]

Dosyaya yeni bir modül ilave edin, kodu yapıştırın .... sonra bir düğmeye falan bağlayıp çalıştırın, o kadar ....

Dakikada 1 kere sorgulamayla birşey olmaz.... bu tür siteler genellikle dakikada 10'dan fazla sorgulama yapılınca IP'i yasaklar.

.

 

[birdhane]

teşekkürler hocam. Bu kodu olduğu gibi sayfanın kod kısmına yapıştırdım ama çalışmadı. Neyi eksik yaptım acaba?

Dosyaya yeni bir modül ilave edin, kodu yapıştırın .... sonra bir düğmeye falan bağlayıp çalıştırın, o kadar ....

Dakikada 1 kere sorgulamayla birşey olmaz.... bu tür siteler genellikle dakikada 10'dan fazla sorgulama yapılınca IP'i yasaklar.

.

Hocam modül ekledim. Tuşla değil de otomatik olarak çalışmasını istediğim için şu kodları "Bu Çalışma Kitabı" bölümüne yapıştırdım ama çalışmadı.
Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:00:40"), "GetData_RegExp"
End Sub

 

[Haluk]

Verdiğim makroyu dosyaya ilave ettiğiniz yeni bir modüle (Bu Çalışma Kitabı veya sayfa modulleri değil !) yerleştirdiyseniz, sizin " Workbook_Open" prosedürüne yazdığınız kod satırı ile; dosya ilk açıldıktan 40 saniye sonra "GetData_RegExp" makrosu çalışır, bir daha da çalışmaz....

Amacınız her 40 saniyede bir verileri alıp, sayfayı güncellemekse; biraz daha detaylı bir kod yazmak gerekir...

.