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

[birdhane]

Sayfa adında BOŞLUK karakteri olabilir kontrol ediniz.

Adları kontrol etmiştim sorun yoktu. Kodların başına On Error Resume Next ifadesini ekledim şimdilik hata vermiyor ama dakikada bir güncellerken 2 dakikada bir güncellemeye başladı. Yani sanki ilkini aldıktan sonra bu hatayı veriyor Hatayla karşılaşınca devam et dediğimde de sonraki dakikadakini alıyor.

 

[Korhan Ayhan]

Ben kendi eklediğim dosyada bir sorunla karşılaşmadım. Sorunsuz çalıştı. Sizin dosyanızda ki durumu bilemiyorum.

 

[birdhane]

Ben kendi eklediğim dosyada bir sorunla karşılaşmadım. Sorunsuz çalıştı. Sizin dosyanızda ki durumu bilemiyorum.

Tekrar teşekkür ediyorum Korhan bey, sağolun. Şöyle bir şey dikkatimi çekti. sanki excell belgesi aktif belgeyken çekiyor ama onu simge durumuna alıp başka işler yaptığımda güncellemiyor gibime geldi.

 

[Korhan Ayhan]

Birde böyle deneyiniz.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim K1 As Workbook, S1 As Worksheet, S2 As Worksheet, Son As Long, Alan As Range, Satir As Long

    Set K1 = ThisWorkbook
    Set S1 = K1.Sheets("Sayfa1")
    Set S2 = K1.Sheets("Sayfa2")

    Application.EnableEvents = False

    Son = S1.Cells(Rows.Count, 1).End(3).Row
    Set Alan = S1.Range("A2:C" & Son)

    Satir = S2.Cells(S2.Rows.Count, 1).End(3).Row + 1

    S2.Range("A" & Satir & ":A" & Satir).Resize(Son - 1).Value = Now
    S2.Range("B" & Satir & ":D" & Satir).Resize(Son - 1).Value = Alan.Value
    S2.Range("A:D").Sort S2.Range("A1"), xlDescending
    S2.Range("A101:A" & S2.Rows.Count).EntireRow.Delete

    Application.EnableEvents = True
End Sub

 

[birdhane]

Ben kendi eklediğim dosyada bir sorunla karşılaşmadım. Sorunsuz çalıştı. Sizin dosyanızda ki durumu bilemiyorum.

Birkaç kere test ettim aktif pencereyken güncelliyor ama penceyi değiştir

Birde böyle deneyiniz.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim K1 As Workbook, S1 As Worksheet, S2 As Worksheet, Son As Long, Alan As Range, Satir As Long

    Set K1 = ThisWorkbook
    Set S1 = K1.Sheets("Sayfa1")
    Set S2 = K1.Sheets("Sayfa2")

    Application.EnableEvents = False

    Son = S1.Cells(Rows.Count, 1).End(3).Row
    Set Alan = S1.Range("A2:C" & Son)

    Satir = S2.Cells(S2.Rows.Count, 1).End(3).Row + 1

    S2.Range("A" & Satir & ":A" & Satir).Resize(Son - 1).Value = Now
    S2.Range("B" & Satir & ":D" & Satir).Resize(Son - 1).Value = Alan.Value
    S2.Range("A:D").Sort S2.Range("A1"), xlDescending
    S2.Range("A101:A" & S2.Rows.Count).EntireRow.Delete

    Application.EnableEvents = True
End Sub

hocam sorunsuz çalıştı size minettarım, çok teşekkür ederim

 

[S.Yiğit]

@Haluk hocam merhaba,

16. mesajınızdaki kodu çalıştırıyorum ama 20 saniye sonra tekrar çalıştırıyorum değerlerde değişme olmuyor. 13 mesajınızdaki sitede sayfayı yenileyince sitedeki değerler değişiyor, sonra kodu tekrar çalıştırıyorum değerler değişmiyor. bende mi sorun var acaba, dosyamı ekledim, yardımınızı rica ederim.

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]

Evet, durum dediğiniz gibi .... ben de sonradan fark ettim.

Halledilir ....

.

 

[Haluk]

Revize edilmiş dosya ektedir...

.

 

[S.Yiğit]

@Haluk hocam,

Revize için teşekkür ederim. Kodları görüntüleri dediğimde hata alıyorum, benden kaynaklı mı acaba?

 

[Haluk]

Dosya çalışıyorsa sorun yok demektir, kodları görüntülemekle uğraşmayın...... çünkü görüntüleyemezsiniz.

.