Webten veri çekimi

[cenkatli]

Arkadaşlar selamlar.
hazırlamış olddugum dosyada merkez bankası kurlarını çeken bir veri çekimi var. Sorum şu olacak, ben kurların gunluk cekimi yapıldıktan sonra o dolar satış kurunu birim fiyat sutununa eger ben bir satış gırersem otamatik atmasını ve o hali ile güncel kalmasını istiyorum. Ben yapmaya çalıştıgım işlemde her kur değiştiginde gecmiş zamandaki satışlarında girilmiş kurları değişiyor. Gecmiş zamanda girilmiş satışların kurlarının değişmesini istemiyorum.
Bir fikir verirseniz sevinirim. Dosyayı elemede hata olusuyor o yuzden ekleme yapamadım
herkese iyi çalışmalar

 

[cenkatli]

Ekte Kucuk Ornek Dosyayi Gorebİlİrsİnİz. Yardimlariniz Bekliyorum

 

[Ferhat Pazarçevirdi]

Ekteki dosyayı inceleyiniz.

 

[cenkatli]

Elinize sağlık cok guzel olmus yalnız sunu bilmek isterimki tam olarak calısma prensibi nedir. Yani siz aynı zamanda gecmiş kurlarıda mı veri olarak alıyorsunuz ve bu sayede sadece o tarihin kuru gorunuyor. veya soyle sorayım yapmıs oldugunuzu ogrenmem adına bıraz acıklarmısınız.
Tesekkurler

 

[Ferhat Pazarçevirdi]

Tabi ki açıklarım. Siz yeter ki, öğrenmek isteyin.

Önce yöntemi seçtik. Neye göre? Sayfaya her veri girildiğinde veya mevcut veriler değiştirildiğinde kurları kontrol etmesini isteriz. Bunu aşağıdaki satırla yaptık

Private Sub Worksheet_Change(ByVal Target As Range)

Daha sonra, sayfadaki herbir hücreye veri girildiğinde, aynı işlem tekrarlanmasın diye bir sınırlama koyduk. Çünkü yukarıdaki satır, değişen tüm hücreleri gözden geçiren genel bir deklerasyon...

If Intersect(Target, [F:F]) Is Nothing Then Exit Sub

Bu satırın anlamı: "Eğer değiştirdiğim hücre F kolonunda değilse, işlemleri hiç yapma" demek.

Girilen değerin tarih olup olmadığını kontrol etmemiz gerekiyordu. Eğer tarih girilmemişse (Örn:"xght" gibi bir değer) prosedür yapısı gereği hata verecekti. Bu kontrolü de aşağıdaki kod bloğunda hallettik.

If IsDate(Target) = False Then
   MsgBox "Girdiğiniz veri bir tarihle uyuşmuyor", vbCritical, "DEĞER HATASI"
   Application.EnableEvents = False
   Target.Value = ""
   Target.Offset(0, 1).Value = ""
   Target.Select
   Application.EnableEvents = True
   Exit Sub
End If

Şimdi değerin tarih olduğunu biliyoruz fakat, girilen değerin haftasonuna denk gelip gelmediğini de kontrol ettirmeliydik. Çünkü, hafta sonları TCMB herhangi bir kur yayınlamıyor. Bunu da aşağıdaki kod bloğuyla hallettik.

x = Weekday(Target.Value, 2)
If x = 6 Or x = 7 Then
   MsgBox "Girdiğiniz tarih Haftasonuna denk geliyor", vbCritical, "HAFTASONU UYARISI"
   Application.EnableEvents = False
   Target.Value = ""
   Target.Offset(0, 1).Value = ""
   Target.Select
   Application.EnableEvents = True
   Exit Sub
End If

Bazı önceden kestirilemeyen hataların engellenmesi için aşağıdaki satırı tedbir olsun diye koyduk.

On Error Resume Next

Daha sonra, bazı değişken tanımları yaptık. Hücerey girilen değeri ay, gün, yıl olarak böldük. Niye yaptık ? Çünkü, bağlanacağımız web sitesinin adresini oluştururken lazım olacak. Bunu da aşağıdaki gibi oluşturduk.

Set sh1 = Sheets("Sheet1")
Set shk = Sheets("Kur")
  yil = Year(Target)
  ay = Month(Target)
  gun = Day(Target)

Daha sonra, web sitesine bağlanırken günün iki karakterle ifade edilmesi gerekliliğini biliyorduk. Yani gün değeri "1" ise bunu "01" şekline getirmeliydik. Keza ay içinde durum aynısı. Bunun için aşağıdaki blok kullanılıyor.

If Len(ay) = 1 Then ay = "0" & ay
If Len(gun) = 1 Then gun = "0" & gun

Şimdi bütün parametleri ayarladığımıza göre bağlanacağımız, tek sorun URL'yi oluşturmaya geldi. URL için aşağıdaki kod kullanıldı.

URL = "URL;http://www.tcmb.gov.tr/kurlar/" & yil & ay & "/" & gun & ay & yil & ".html"

Daha sonra, Bu URL'yi kullanarak, "KUR" sayfasına girilen güne ait değerler bir sorgu yardımı ile alındı. Buradaki kodları bir makro kaydederek elde edebilirsiniz. Tabi daha öncesinde, bu sayfayı temizlememiz gerekiyordu.

Sheets("KUR").Range("A:F").ClearContents
With Sheets("KUR").QueryTables.Add(Connection:= _
         URL, Destination:=Sheets("KUR").Range("A1"))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
End With

En son olarak da; tarih girilen hücrenin sağ yanındaki hücreye, KUR sayfasındaki USD satış değerini atadık ve sayı formatını değiştirdik.(Aşağıdaki blokla)

Target.Offset(0, 1).Value = shk.[D13] / 10000
Target.Offset(0, 1).NumberFormat = "#,##0.0000"

set ettiğimiz objeleri serbest bıraktık.

Set sh1 = Nothing
Set sh2 = Nothing
End Sub

İşte hepsi bu kadar ....

 

[cenkatli]

Elinize, emeginize ve zamanınıza bereket, cok sagolun