• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Singapur Doları ve Bahreyn Dinarı Kur Bilgisi

B

baydeniro

Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
Son düzenleme:
Haluk üstadım çok teşekkür ederim. Bu konuyu incelemiştim. Ama Singapur Doları (SGD) ve Bahreyn Dinarı (BHD) kur bilgisini nasıl çekebileceğimize dair bir kısmı fark edemedim.
 
"Get_TCMB_XML_Data.xlsm" dosyasında Bilgi_Amacli_Kurlar sayfasinda ilgili tarihi yazıp, butona tıkladığınızda, veriler gelir...

.
 
üstad acaba rica etsem, size zahmet olmazsa DM den dosya linkini paylaşmanız mümkün müdür
 
Haluk üstadım muhteşemsiniz, çok çok teşekkür ediyorum. Harikulade bir çalışma. Sağlıcakla kalın
 
Haluk Bey Merhaba, öncelikle yazdığınız fonksiyon için teşekkür ederim.

Bana girilen tarihin bir önceki günün (pazar günü için 2 gün, pazartesi günü için 3 gün önceki) kuru gerekiyor. Aşağıdaki kodla bunu hallediyorum.

Ancak hafta içine denk gelen resmi tatillerde kurlarda sorun çıkıyor.

Örneğin girilen tarih 24/04/2019 olsun, aşağıdaki kodla 23/04/2019 tarihli kuru alacak. Ancak 23/04/2019 tarihinde resmi tatil olduğu için hata veriyor.

Bu hata olduğunda bana 23/04/2019 kurunu değil 22/04/2019 tarihinin kuru gelsin istiyorum. Yardımınız için teşekkürler.

Kod: 
    If Weekday(Tarih, vbMonday) <= 6 And Weekday(Tarih, vbMonday) >= 2 Then
        Tarih = Tarih - 1
    ElseIf Weekday(Tarih, vbMonday) = 7 Then
        Tarih = Tarih - 2
    ElseIf Weekday(Tarih, vbMonday) = 1 Then
        Tarih = Tarih - 3
    End If
 
Son düzenleme:
Function BHD(ByVal tarih As Date)
Dim haftaningunu As String, gun As String, ay As String, yil As String, path As String, kur As Double
Dim evn As Variant
Dim ilkTarih As Date ''Ekleme yapacağımız tarihi tanımladık
Dim EklenecekSure, i As Integer
gun = Day(tarih): ay = Month(tarih): yil = Year(tarih)
haftaningunu = Weekday(tarih, vbMonday) 'Haftanın gününü buluyoruz
ilkTarih = tarih
If haftaningunu = 1 Then EklenecekSure = -3 'Pazartesi ise 3 gün öncesini alıyoruz
If haftaningunu = 2 Then EklenecekSure = -1 'salı ise 1 gün öncesini alıyoruz
If haftaningunu = 3 Then EklenecekSure = -1 'çarş. ise 1 gün öncesini alıyoruz
If haftaningunu = 4 Then EklenecekSure = -1 'perş. ise 1 gün öncesini alıyoruz
If haftaningunu = 5 Then EklenecekSure = -1 'cuma ise 1 gün öncesini alıyoruz
If haftaningunu = 6 Then EklenecekSure = -1 'ctesi ise 2 gün öncesini alıyoruz
If haftaningunu = 7 Then EklenecekSure = -2 'Pazar ise 2 gün öncesini alıyoruz
yenitarih = DateAdd("d", EklenecekSure, ilkTarih)
gun = Day(yenitarih): ay = Month(yenitarih): yil = Year(yenitarih)
If Len(gun) = 1 Then gun = "0" & gun
If Len(ay) = 1 Then ay = "0" & ay
Set Veri = CreateObject("MSXML2.DOMDocument")
Veri.async = False
Veri.Load ("http://www.tcmb.gov.tr/bilgiamackur/" & yil & ay & "/" & gun & ay & yil & ".xml")
Set Nod = Veri.SelectNodes("//Currency[@Kod='BHD']/ExchangeRate")
For Each Item In Nod
i = i + 1
evn = Item.Text
evn = Val(evn)
'evn = Format(evn, "#,#####0.00000")
Next Item
Set Veri = Nothing: Set Nod = Nothing
Set Item = Nothing: i = Empty
BHD = evn
If evn = 0 Then
yenisure = EklenecekSure - 1
yenitarih2 = DateAdd("d", yenisure, ilkTarih)
gun = Day(yenitarih2): ay = Month(yenitarih2): yil = Year(yenitarih2)
If Len(gun) = 1 Then gun = "0" & gun
If Len(ay) = 1 Then ay = "0" & ay
Set Veri = CreateObject("MSXML2.DOMDocument")
Veri.async = False
Veri.Load ("http://www.tcmb.gov.tr/bilgiamackur/" & yil & ay & "/" & gun & ay & yil & ".xml")
Set Nod = Veri.SelectNodes("//Currency[@Kod='BHD']/ExchangeRate")
For Each Item In Nod
i = i + 1
evn = Item.Text
evn = Val(evn)
Next Item
Set Veri = Nothing: Set Nod = Nothing
Set Item = Nothing: i = Empty
BHD = evn
End If
If evn = 0 Then
yenisure = EklenecekSure - 2
yenitarih2 = DateAdd("d", yenisure, ilkTarih)
gun = Day(yenitarih2): ay = Month(yenitarih2): yil = Year(yenitarih2)
If Len(gun) = 1 Then gun = "0" & gun
If Len(ay) = 1 Then ay = "0" & ay
Set Veri = CreateObject("MSXML2.DOMDocument")
Veri.async = False
Veri.Load ("http://www.tcmb.gov.tr/bilgiamackur/" & yil & ay & "/" & gun & ay & yil & ".xml")
Set Nod = Veri.SelectNodes("//Currency[@Kod='BHD']/ExchangeRate")
For Each Item In Nod
i = i + 1
evn = Item.Text
evn = Val(evn)
Next Item
Set Veri = Nothing: Set Nod = Nothing
Set Item = Nothing: i = Empty
BHD = evn
End If
If evn = 0 Then
yenisure = EklenecekSure - 3
yenitarih2 = DateAdd("d", yenisure, ilkTarih)
gun = Day(yenitarih2): ay = Month(yenitarih2): yil = Year(yenitarih2)
If Len(gun) = 1 Then gun = "0" & gun
If Len(ay) = 1 Then ay = "0" & ay
Set Veri = CreateObject("MSXML2.DOMDocument")
Veri.async = False
Veri.Load ("http://www.tcmb.gov.tr/bilgiamackur/" & yil & ay & "/" & gun & ay & yil & ".xml")
Set Nod = Veri.SelectNodes("//Currency[@Kod='BHD']/ExchangeRate")
For Each Item In Nod
i = i + 1
evn = Item.Text
evn = Val(evn)
Next Item
Set Veri = Nothing: Set Nod = Nothing
Set Item = Nothing: i = Empty
BHD = evn
End If
If evn = 0 Then
yenisure = EklenecekSure - 4
yenitarih2 = DateAdd("d", yenisure, ilkTarih)
gun = Day(yenitarih2): ay = Month(yenitarih2): yil = Year(yenitarih2)
If Len(gun) = 1 Then gun = "0" & gun
If Len(ay) = 1 Then ay = "0" & ay
Set Veri = CreateObject("MSXML2.DOMDocument")
Veri.async = False
Veri.Load ("http://www.tcmb.gov.tr/bilgiamackur/" & yil & ay & "/" & gun & ay & yil & ".xml")
Set Nod = Veri.SelectNodes("//Currency[@Kod='BHD']/ExchangeRate")
For Each Item In Nod
i = i + 1
evn = Item.Text
evn = Val(evn)
Next Item
Set Veri = Nothing: Set Nod = Nothing
Set Item = Nothing: i = Empty
BHD = evn
End If
If evn = 0 Then
yenisure = EklenecekSure - 5
yenitarih2 = DateAdd("d", yenisure, ilkTarih)
gun = Day(yenitarih2): ay = Month(yenitarih2): yil = Year(yenitarih2)
If Len(gun) = 1 Then gun = "0" & gun
If Len(ay) = 1 Then ay = "0" & ay
Set Veri = CreateObject("MSXML2.DOMDocument")
Veri.async = False
Veri.Load ("http://www.tcmb.gov.tr/bilgiamackur/" & yil & ay & "/" & gun & ay & yil & ".xml")
Set Nod = Veri.SelectNodes("//Currency[@Kod='BHD']/ExchangeRate")
For Each Item In Nod
i = i + 1
evn = Item.Text
evn = Val(evn)
Next Item
Set Veri = Nothing: Set Nod = Nothing
Set Item = Nothing: i = Empty
BHD = evn
End If
If evn = 0 Then
yenisure = EklenecekSure - 6
yenitarih2 = DateAdd("d", yenisure, ilkTarih)
gun = Day(yenitarih2): ay = Month(yenitarih2): yil = Year(yenitarih2)
If Len(gun) = 1 Then gun = "0" & gun
If Len(ay) = 1 Then ay = "0" & ay
Set Veri = CreateObject("MSXML2.DOMDocument")
Veri.async = False
Veri.Load ("http://www.tcmb.gov.tr/bilgiamackur/" & yil & ay & "/" & gun & ay & yil & ".xml")
Set Nod = Veri.SelectNodes("//Currency[@Kod='BHD']/ExchangeRate")
For Each Item In Nod
i = i + 1
evn = Item.Text
evn = Val(evn)
Next Item
Set Veri = Nothing: Set Nod = Nothing
Set Item = Nothing: i = Empty
BHD = evn
End If
If evn = 0 Then
yenisure = EklenecekSure - 7
yenitarih2 = DateAdd("d", yenisure, ilkTarih)
gun = Day(yenitarih2): ay = Month(yenitarih2): yil = Year(yenitarih2)
If Len(gun) = 1 Then gun = "0" & gun
If Len(ay) = 1 Then ay = "0" & ay
Set Veri = CreateObject("MSXML2.DOMDocument")
Veri.async = False
Veri.Load ("http://www.tcmb.gov.tr/bilgiamackur/" & yil & ay & "/" & gun & ay & yil & ".xml")
Set Nod = Veri.SelectNodes("//Currency[@Kod='BHD']/ExchangeRate")
For Each Item In Nod
i = i + 1
evn = Item.Text
evn = Val(evn)
Next Item
Set Veri = Nothing: Set Nod = Nothing
Set Item = Nothing: i = Empty
BHD = evn
End If
End Function
 
Komut çalışma şekli:

boş hücreye tarih yazın, herhangi bir hücreye
=BHD(Tarih yazılı olan hücre)
 
usd

Function USD(ByVal xTarih As Date)
Const xmlURL1 = "http://tcmb.gov.tr/kurlar/today.xml"
Const xmlURL2 = "http://www.tcmb.gov.tr/kurlar/%p1/%p2.xml"
Dim xmlTCMB
Dim xmlNODE
Dim xmlURL As String
Dim Sor
If IsEmpty(xTarih) Or xTarih = #12:00:00 AM# Then
xTarih = Date
End If
If xTarih >= Date Then
xmlURL = xmlURL1
Else
xmlURL = Replace(Replace(xmlURL2, "%p1", Format(xTarih - 1, "yyyymm")), "%p2", Format(xTarih - 1, "ddmmyyyy"))
End If
Do Until XMLVarmi(xmlURL)
If xmlURL <> xmlURL1 Then
xTarih = xTarih - 1
If xTarih < #6/18/2002# Then GoTo HATA
xmlURL = Replace(Replace(xmlURL2, "%p1", Format(xTarih, "yyyymm")), "%p2", Format(xTarih, "ddmmyyyy"))
Else
GoTo HATA
End If
DoEvents
Loop
Set xmlTCMB = CreateObject("MSXML2.DOMDocument.6.0")
xmlTCMB.Load xmlURL
Do
DoEvents
Loop Until xmlTCMB.parsed = True
Set xmlNODE = xmlTCMB.SelectNodes("Tarih_Date/Currency[@Kod='USD']")
USD = Val(xmlNODE.Item(0).SelectNodes("ForexBuying").Item(0).Text)
Set xmlTCMB = Nothing
Set xmlNODE = Nothing

Exit Function
HATA:
Set xmlTCMB = Nothing
Set xmlNODE = Nothing

USD = "İnternet Bağlantısı Yok veya TCMB sistemi sorunlu"
End Function
Private Function XMLVarmi(URL As String) As Boolean
Dim HTTPBaglanti As Object
Set HTTPBaglanti = CreateObject("WinHttp.WinHttpRequest.5.1")
On Error GoTo XMLVarmi_Error
HTTPBaglanti.Open "GET", URL
HTTPBaglanti.send
If HTTPBaglanti.Status = 200 Then
XMLVarmi = True
Else
XMLVarmi = False
End If
Set HTTPBaglanti = Nothing
Exit Function
XMLVarmi_Error:
Set HTTPBaglanti = Nothing
XMLVarmi = False
End Function
 
(Yukarıdaki kod yığınları yüzünden sorumu tekrar gönderiyorum.)

Haluk Bey Merhaba, öncelikle yazdığınız fonksiyon için teşekkür ederim.

Bana girilen tarihin bir önceki günün (pazar günü için 2 gün, pazartesi günü için 3 gün önceki) kuru gerekiyor. Aşağıdaki kodla bunu hallediyorum.

Ancak hafta içine denk gelen resmi tatillerde kurlarda sorun çıkıyor.

Örneğin girilen tarih 24/04/2019 olsun, aşağıdaki kodla 23/04/2019 tarihli kuru alacak. Ancak 23/04/2019 tarihinde resmi tatil olduğu için hata veriyor.

Bu hata olduğunda bana 23/04/2019 kurunu değil 22/04/2019 tarihinin kuru gelsin istiyorum. Yardımınız için teşekkürler.


Kod: 
If Weekday(Tarih, vbMonday) <= 6 And Weekday(Tarih, vbMonday) >= 2 Then
        Tarih = Tarih - 1
    ElseIf Weekday(Tarih, vbMonday) = 7 Then
        Tarih = Tarih - 2
    ElseIf Weekday(Tarih, vbMonday) = 1 Then
        Tarih = Tarih - 3
    End If
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst