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
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.
'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
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)
'----------------------------------------------------------------------------------------------------------------------