• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

B

birdhane

Katılım
16 Aralık 2019
Mesajlar
63
Excel Vers. ve Dili
Excell 2019 TR
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?
 
217772

Yukarıdaki görseldeki ilgili yerler belki işe yarayabilir.
 
Örnek dosya paylaşırsanız makro ile çözüm üretilebilir.
 
muratboz06' Alıntı:
Örnek dosya paylaşırsanız makro ile çözüm üretilebilir.
Genişletmek için tıkla ...
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.
 

Ekli dosyalar

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

Siz bir kontrol eder misiniz? Sizde var mı?
 
Korhan Ayhan' Alıntı:
Sayfa olaylarında TableUpdate eklenmiş. Ben ofis 2010'da göremedim.

Siz bir kontrol eder misiniz? Sizde var mı?
Genişletmek için tıkla ...
Aşağıdaki kodu denedim ama verileri aktarmadı. Muhtemelen Target ile Tabloyu birbiriyle eşleştirmede hata var ama herhangi bir hata da vermiyor:

PHP: 
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
 
Korhan Ayhan' Alıntı:
Sayfa olaylarında TableUpdate eklenmiş. Ben ofis 2010'da göremedim.

Siz bir kontrol eder misiniz? Sizde var mı?
Genişletmek için tıkla ...
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.
 
YUSUF44' Alıntı:
Aşağıdaki kodu denedim ama verileri aktarmadı. Muhtemelen Target ile Tabloyu birbiriyle eşleştirmede hata var ama herhangi bir hata da vermiyor:

PHP: 
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
Genişletmek için tıkla ...
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
 
birdhane' Alıntı:
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
Genişletmek için tıkla ...
Fikrim yok, Korhan Bey'in önerdiği çözümü kullanabilir miyim diye uğraşmıştım ama beceremedim maalesef.
 
Dosyanızı dosya.co sitesine yükleyip link paylaşırmısınız.
 
Kod: 
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

.
 
Haluk' Alıntı:
Kod: 
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

.
Genişletmek için tıkla ...
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ı?
 
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' Alıntı:
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?
Genişletmek için tıkla ...
Haluk' Alıntı:
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.

.
Genişletmek için tıkla ...
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
 
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...

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