Otomatik veri yenileme

[sinan05]

Merhabalar. Dosyamın DÖVİZ sayfasında dış verileri yenileyip verileri güncelliyorum. Veri çektiğim 5 adet tablo var. F4:F14 arası hücreler de bu tablodaki verilerle bağlantılı şekilde çarpım yapıyor. F15 Hücresinde bu hücreleri topluyor. Sonrada veriler güncellenince makro ile kaydediyorum. Yapmak istediğim makro ile tabloları her 30 dakikada bir otomatik yenilemek, yenileme başarısız olup #DEĞER! İşareti çıkarsa tekrar yenilesin, yenilemeden sonrada VERİLER makrosunu çalışsın. Aşağıya eklediğim makroyu çalıştırdım olmadı verileri yenilemiyor. Bende F15 hücresi değişince makro çalışsın istedim o da olmadı. Nerde hata yapıyorum bilemedim. Veri ayarların da mı hata var bilemedim. Yardımlarınız için teşekkür ederim.

Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:03:00"), "YenileVeKontrol"
End Sub

Sub YenileVeKontrol()
On Error GoTo YenilemeHatasi
ThisWorkbook.Worksheets("DÖVİZ").Range("F4:F14").Refresh
Application.OnTime Now + TimeValue("00:03:00"), "YenileVeKontrol"

If IsError(ThisWorkbook.Worksheets("DÖVİZ").Range("F15").Value) Then
Call YenileVeKontrol
Else
Static oldValue As Variant
Dim newValue As Variant
newValue = ThisWorkbook.Worksheets("DÖVİZ").Range("F15").Value
If oldValue <> newValue Then
oldValue = newValue
Call VERİLER
End If
End If
Exit Sub

YenilemeHatasi:
Call YenileVeKontrol
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("I1")) Is Nothing Then
Call DovizVeriKopyalaYapistir
End If
If Not Intersect(Target, Me.Range("F4:F14")) Is Nothing Then
Call YenileVeKontrol
End If
If Not Intersect(Target, Me.Range("F15")) Is Nothing Then
Static oldValue As Variant
Dim newValue As Variant
newValue = Me.Range("F15").Value
If oldValue <> newValue Then
oldValue = newValue
Call VERİLER
End If
End If
End Sub

 

[tugkan]

Merhaba,
Dener misiniz.
Veri yenileme ve hatalarla başa çıkma konusunda oluşturduğunuz makroda bazı düzeltmeler ve eklemeler yapmamız gerekebilir. Aşağıdaki adımlarla sorunu çözebiliriz:

1. Veri Yenileme İşlemi: .Refresh metodu tabloyu değil, sorgu tablolarını (QueryTable) yeniler. Eğer bu tablolar dış bağlantılarla geliyorsa, bu yöntemi kullanmak yerine Workbook.Connections("Connection Name").Refresh gibi bir yöntem gerekebilir.
2. Hata Yönetimi ve Tekrar Deneme: Hata oluştuğunda makroyu yeniden çalıştırmak yerine, önce tabloyu yeniden deneyeceğiz, ardından verileri kontrol edeceğiz.
3. Zamanlayıcı Doğru Kurulumu: Application.OnTime ile zamanlayıcı kurarken, yeni bir işlem başlatmak için saat bazlı bir zamanlamayı doğru yapmalıyız.

İşte güncellenmiş makro önerisi:

Private Sub Workbook_Open()
    Application.OnTime Now + TimeValue("00:30:00"), "YenileVeKontrol"
End Sub

Sub YenileVeKontrol()
    On Error GoTo YenilemeHatasi

    ' Dış bağlantılı verilerin yenilenmesi
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("DÖVİZ")
    
    ' Bağlantıyı yenile
    For Each qt In ws.QueryTables
        qt.Refresh BackgroundQuery:=False
    Next qt
    
    ' Bağlantı hatası kontrolü
    If IsError(ws.Range("F15").Value) Then
        Call YenileVeKontrol ' Eğer hata varsa yeniden dene
    Else
        Static oldValue As Variant
        Dim newValue As Variant
        newValue = ws.Range("F15").Value
        
        If oldValue <> newValue Then
            oldValue = newValue
            Call VERİLER ' Veriler değiştiyse VERİLER makrosunu çalıştır
        End If
    End If
    
    ' Yeniden 30 dakika sonra yenileme başlat
    Application.OnTime Now + TimeValue("00:30:00"), "YenileVeKontrol"
    
    Exit Sub

YenilemeHatasi:
    ' Eğer bir hata olursa tekrar dene
    Call YenileVeKontrol
End Sub

Açıklamalar:

• .QueryTables ile dış bağlantıları yenileyerek tabloyu güncelleyebilirsiniz.
• IsError ile F15 hücresindeki hatayı kontrol eder ve hata varsa yeniden denemeyi sağlar.
• 30 dakikalık zamanlayıcıyı kurmak için Application.OnTime metodunu kullandık.

Bu kodu denedikten sonra hâlâ sorun yaşarsanız, veri kaynağı ya da yenileme yönteminde bir inceleme gerekebilir.

 

[pitchoute]

Merhabalar, deneyip sonucu paylaşabilir misiniz;

Private Sub Workbook_Open()
    Application.OnTime Now + TimeValue("00:00:10"), "YenileVeKontrol"
End Sub

Sub YenileVeKontrol()
    Dim refreshSuccess As Boolean
    Dim retryCount As Integer
    Dim maxRetries As Integer
    Dim waitTime As Date
    Dim newValue As Variant
    Static oldValue As Variant
    
    refreshSuccess = False
    retryCount = 0
    maxRetries = 5
    waitTime = TimeValue("00:00:05")
    
    Do While Not refreshSuccess And retryCount < maxRetries
        On Error Resume Next
        ThisWorkbook.RefreshAll
        Application.Calculate
        DoEvents
        On Error GoTo 0
        
        If Not IsError(ThisWorkbook.Worksheets("DÖVİZ").Range("F15").Value) Then
            refreshSuccess = True
        Else
            retryCount = retryCount + 1
            Application.Wait (Now + waitTime)
        End If
    Loop
    
    If refreshSuccess Then
        newValue = ThisWorkbook.Worksheets("DÖVİZ").Range("F15").Value
        If newValue <> oldValue Then
            oldValue = newValue
            Call VERİLER
        End If
    Else
        MsgBox "Veriler " & maxRetries & " denemeden sonra yenilenemedi.", vbCritical
    End If
    
    Application.OnTime Now + TimeValue("00:30:00"), "YenileVeKontrol"
End Sub