Macro'yla TCMB Döviz Kurlarının Getirtilmesi

Belli tarihteki tek dövizin ve tüm dövizlerin kurlarının getirtilmesi ile ilgili Macro prosedürlerini aşağıda bulabilirsiniz. 
Prosedürler, girilen tarihin hafta içi olup olmadığını kontrol etmektedir. 
'----------------------------------------------------------------------------------------------------------------------
Excel dosyasındaki Döviz Kodları sayfasında gerekli olan Döviz Kodları için
Aşağıdaki görüntülerden hemen önceki Döviz Kodları listesini bir metin dosyasına kopyalayın. 
Metin dosyasını örneğin Döviz Kodları ismiyle kaydedin. 
Sonra, Excel dosyasını açın ve Döviz Kodları isimli bir sayfa ekleyin. 
Bu sayfadayken Excel programının Veri sekmesindeki Dış Veri Al kısmında bulunan Metinden düğmesini seçin. 
Açılan ekranda Sınırlandırılmış seçiliyken İleri düğmesine basın.
Sınırlandırılmış seçeneğinin bulunduğu ekranda Türkçeye özgü karakterlerde görüntüsel sorun varsa bu ekrandaki Dosya kaynağı alanından uygun bir seçenekle Türkçe karakterleri doğru görünür yapın. 
Daha sonra açılan ekrandaki Diğer isimli seçeneği seçin ve bu seçeneğin alanına düşey çubuk "|" işaretini girin ve sırasıyla İleri, Son düğmelerine tıklayın. Düşey çubuk kullanmamızın sebebi kodlar ile adlar arasında ayıraç olarak "|" kullanmış olmamızdır. 
'----------------------------------------------------------------------------------------------------------------------

'Belli Tarihteki Tek Dövizin Kurlarının Getirtilmesi
'Aşağıdaki prosedür, Tek Döviz sayfasındaki Döviz Kodu ve Tarih hücrelerinde değişiklik yapılınca çalışmaktadır. 
'Bu prosedür, Tek Döviz sayfasındaki sayfadaki ilgili hücrelerde değişiklik olunca çalışması için Macro kısmına yazılmıştır ve yazılmalıdır. 

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Or Target.Address = "$B$1" Then
 
 Dim Aranan, gun As String, ay As String, yil As String, path As String
 Dim xmlDoc, DovizListesi, Dovizler As Object
 Dim Tarih As Date
 Dim HaftaIciGunNo, r As Integer
 Dim OrjIsim, DovizAdi, BirimDegeri, DovizKodu, DovizAlis, DovizSatis, EfektifAlis, EfektifSatis As String
 Set xmlDoc = CreateObject("Msxml.DOMDocument")
 Application.Volatile
 
 Aranan = UCase(Range("A2"))
 Tarih = Range("B1")
 HaftaIciGunNo = WorksheetFunction.Weekday(Tarih, 2)
 If HaftaIciGunNo = 6 Or HaftaIciGunNo = 7 Then
  MsgBox "Tarih hafta içi olmalı"
  Exit Sub
 End If
 gun = Day(Tarih): ay = Month(Tarih): yil = Year(Tarih)
 If Len(gun) = 1 Then gun = "0" & gun
 If Len(ay) = 1 Then ay = "0" & ay
 path = "https://www.tcmb.gov.tr/kurlar/" & yil & ay & "/" & gun & ay & yil & ".xml"
 xmlDoc.async = False
 xmlDoc.Load path
 Set DovizListesi = xmlDoc.DocumentElement.SelectNodes("Currency")
 Cells(3, 1) = "Döviz Alış"
 Cells(4, 1) = "Döviz Satış"
 Cells(5, 1) = "Efektif Alış"
 Cells(6, 1) = "Efektif Satış"
 
 For Each Dovizler In DovizListesi
   DovizAdi = Dovizler.SelectSingleNode("Isim").Text
   If DovizAdi = Aranan Then
     OrjIsim = Dovizler.SelectSingleNode("CurrencyName").Text
     BirimDegeri = Dovizler.SelectSingleNode("Unit").Text
     DovizAlis = Dovizler.SelectSingleNode("ForexBuying").Text
     Cells(3, 2) = DovizAlis
     DovizSatis = Dovizler.SelectSingleNode("ForexSelling").Text
     Cells(4, 2) = DovizSatis
     EfektifAlis = Dovizler.SelectSingleNode("BanknoteBuying").Text
     Cells(5, 2) = EfektifAlis
     EfektifSatis = Dovizler.SelectSingleNode("BanknoteSelling").Text
     Cells(6, 2) = EfektifSatis
     Exit For
   End If
 Next Dovizler
 
 Set xmlDoc = Nothing
End If
End Sub

'----------------------------------------------------------------------------------------------------------------------

'Belli Tarihteki Tüm Dövizlerin Kurlarının Getirtilmesi

'Aşağıdaki prosedür, Tüm Dövizler sayfasındaki Tarih hücresinde değişiklik yapılınca çalışmaktadır. 
'Bu prosedür, Tüm Dövizler sayfasındaki sayfadaki ilgili hücrede değişiklik olunca çalışması için Macro kısmına yazılmıştır ve yazılmalıdır. 

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$1" Then
 
 Dim gun, ay, yil, path As String
 Dim Tarih As Date
 Dim HaftaIciGunNo, r, BirimDegeri As Integer
 Dim OrjIsim, DovizAdi, DovizKodu, DovizAlis, DovizSatis, EfektifAlis, EfektifSatis As String
 Dim xmlDoc, DovizListesi, Dovizler As Object
 Set xmlDoc = CreateObject("Msxml.DOMDocument")
 Application.Volatile
 
 Tarih = Range("B1")
 HaftaIciGunNo = WorksheetFunction.Weekday(Tarih, 2)
 If HaftaIciGunNo = 6 Or HaftaIciGunNo = 7 Then
  MsgBox "Tarih hafta içi olmalı"
  Exit Sub
 End If
 gun = Day(Tarih): ay = Month(Tarih): yil = Year(Tarih)
 If Len(gun) = 1 Then gun = "0" & gun
 If Len(ay) = 1 Then ay = "0" & ay
 path = "https://www.tcmb.gov.tr/kurlar/" & yil & ay & "/" & gun & ay & yil & ".xml"
 xmlDoc.async = False
 xmlDoc.Load path
 Set DovizListesi = xmlDoc.DocumentElement.SelectNodes("Currency")
 r = 2
 Cells(r, 1) = "Adı"
 Cells(r, 2) = "Kodu"
 Cells(r, 3) = "Döviz Alış"
 Cells(r, 4) = "Döviz Satış"
 Cells(r, 5) = "Efektif Alış"
 Cells(r, 6) = "Efektif Satış"
 Range(Cells(r, 1), Cells(r, 6)).Font.Bold = True
 Range(Cells(2, 2), Cells(30, 6)).NumberFormat = "0.00000"
 
 For Each Dovizler In DovizListesi
   r = r + 1
   OrjIsim = Dovizler.SelectSingleNode("CurrencyName").Text
   BirimDegeri = Dovizler.SelectSingleNode("Unit").Text
   DovizAdi = Dovizler.SelectSingleNode("Isim").Text
   Cells(r, 1) = DovizAdi
   DovizAlis = Dovizler.SelectSingleNode("ForexBuying").Text
   Cells(r, 2) = WorksheetFunction.Index(Sheets("Döviz Kodları").Range("A2:A21"), WorksheetFunction.Match(Cells(r, 1), Sheets("Döviz Kodları").Range("B2:B21"), 0), 1)
   Cells(r, 3) = DovizAlis
   DovizSatis = Dovizler.SelectSingleNode("ForexSelling").Text
   Cells(r, 4) = DovizSatis
   EfektifAlis = Dovizler.SelectSingleNode("BanknoteBuying").Text
   Cells(r, 5) = EfektifAlis
   EfektifSatis = Dovizler.SelectSingleNode("BanknoteSelling").Text
   Cells(r, 6) = EfektifSatis
 Next Dovizler
 
 Set xmlDoc = Nothing
End If
End Sub

'----------------------------------------------------------------------------------------------------------------------

KOD|ADI
USD|ABD DOLARI
AUD|AVUSTRALYA DOLARI
DKK|DANİMARKA KRONU
EUR|EURO
GBP|İNGİLİZ STERLİNİ
CHF|İSVİÇRE FRANGI
SEK|İSVEÇ KRONU
CAD|KANADA DOLARI
KWD|KUVEYT DİNARI
NOK|NORVEÇ KRONU
SAR|SUUDİ ARABİSTAN RİYALİ
JPY|JAPON YENİ
BGN|BULGAR LEVASI
RON|RUMEN LEYİ
RUB|RUS RUBLESİ
IRR|İRAN RİYALİ
CNY|ÇİN YUANI
PKR|PAKİSTAN RUPİSİ
QAR|KATAR RİYALİ
SDR|ÖZEL ÇEKME HAKKI (SDR)
'----------------------------------------------------------------------------------------------------------------------






































































































Bu blogdaki popüler yayınlar

Power BI'da Yeni Sütun Eklemek

Power BI Kullanımına Giriş

Power BI Üzerinde Fonksiyon Oluşturma ve Kullanma

Kümülatif Toplam

Ağırlıklı Ortalama Hesabı

SQL'de Group By Yaparak Rapor Oluşturmak

SQL'de Birden Fazla Tablodan Listeleme Yapmak

ETarihli Fonksiyonu

Bir Ürünün En Son Tarihli Fiyatının Bulunması