İnternetten alınan kurlarda tatil günlerinde sıfır gelmesi

Erkan Yılmaz

Erkan Yılmaz

Katılım
3 Kasım 2010
Mesajlar
219
Excel Vers. ve Dili
Excel 2016 - Türkçe
Merhaba Arkadaşlar,

Yapmış olduğum çalışmamda makro yardımı ile ve aşağıda ki kodlarla tarihlere göre kurları "May Veri Girişi" sayfamda R sütununa formül yardımı ile geliyor ancak resmi tatil günlerinde sıfır olarak gelmektedir. Resmi tatil günlerinde ve hafta sonu tatillerinde bir önceki günün kurunu almamız ve kullanmamız gerekir. Nasıl yapabiliriz.?

Bu konuda yardımcı olabilirseniz çok memnun olurum.

DefVar E
Function Webdoviz(ByVal Tarih As Date, ByVal Dovtip As String, ByVal Tipi As Long) As Variant
Dim gun As String, ay As String, yil As String, path As String, kur As Double
Dim icerik As String, xmlhttp As Object, evn As Variant
Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
Application.Volatile
Dovtip = UCase(Dovtip)
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 = "http://www.tcmb.gov.tr/kurlar/" & yil & ay & "/" & gun & ay & yil & ".xml"
xmlhttp.Open "GET", path, False
xmlhttp.send "at"
If xmlhttp.Status = 200 Then
icerik = xmlhttp.responseText
temizlik = Split(icerik, "<Currency CrossOrder=")
For y = 0 To UBound(temizlik)
If temizlik(y) Like "*=""" & Dovtip & "*" Then
sonuclar = Split(temizlik(y), "</CurrencyName>")
evn1 = Split(sonuclar(1), "<ForexBuying>")
evn2 = Split(sonuclar(1), "<ForexSelling>")
evn3 = Split(sonuclar(1), "<BanknoteBuying>")
evn4 = Split(sonuclar(1), "<BanknoteSelling>")
Select Case Tipi
Case 1: evn = Split(evn1(1), "</")
Case 2: evn = Split(evn2(1), "</")
Case 3: evn = Split(evn3(1), "</")
Case 4: evn = Split(evn4(1), "</")
End Select
Exit For
End If
Next y
End If
'Kuruş hanesini benim gibi virgül kullananlar için
Webdoviz = Replace(evn(0), ".", ",")

'Kuruş hanesini nokta kullananlar için
'Webdoviz = evn(0)
End Function


https://dosya.co/vrwmo3ya9rdn/FB_Daily_Extra_Report_-_Mayıs_2019.rar.html
 
halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,760
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Bu kodu bir dene
Rich (BB code): 
DefVar E
Function Webdoviz(ByVal Tarih As Date, ByVal Dovtip As String, ByVal Tipi As Long) As Variant
Dim gun As String, ay As String, yil As String, path As String, kur As Double
Dim icerik As String, xmlhttp As Object, evn As Variant
Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
Application.Volatile
Dovtip = UCase(Dovtip)


If CDate(Tarih) = CDate(Format(Now, "dd.mm.yyyy")) And "15:30:00" >= CDate(Format(Now, "hh:nn")) Then
Tarih = Tarih - 1
End If

If "Cumartesi" = Format(Tarih, "dddd") Then
Tarih = Tarih - 1
End If
If "Pazar" = Format(Tarih, "dddd") Then
Tarih = Tarih - 2
End If


'Ramazan Bayramı
If "03.06" = Format((Tarih), "dd/mm") Then
Tarih = Tarih - 1
End If
If "04.06" = Format((Tarih), "dd/mm") Then
Tarih = Tarih - 2
End If
If "05.06" = Format((Tarih), "dd/mm") Then
Tarih = Tarih - 3
End If
If "06.06" = Format((Tarih), "dd/mm") Then
Tarih = Tarih - 4
End If

'Kurban Bayramı
If "10.08" = Format((Tarih), "dd/mm") Then
Tarih = Tarih - 1
End If
If "11.08" = Format((Tarih), "dd/mm") Then
Tarih = Tarih - 2
End If
If "12.08" = Format((Tarih), "dd/mm") Then
Tarih = Tarih - 3
End If
If "13.08" = Format((Tarih), "dd/mm") Then
Tarih = Tarih - 4
End If
If "14.08" = Format((Tarih), "dd/mm") Then
Tarih = Tarih - 5
End If


If "01.01" = Format((Tarih), "dd/mm") Or "23.04" = Format((Tarih), "dd/mm") Or "01.05" = Format((Tarih), "dd/mm") Or "19.05" = Format((Tarih), "dd/mm") _
Or "30.08" = Format((Tarih), "dd/mm") Or "28.10" = Format((Tarih), "dd/mm") Or "29.10" = Format((Tarih), "dd/mm") Then
Tarih = Tarih - 1
End If

If "Cumartesi" = Format(Tarih, "dddd") Then
Tarih = Tarih - 1
End If
If "Pazar" = Format(Tarih, "dddd") Then
Tarih = Tarih - 2
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 = "http://www.tcmb.gov.tr/kurlar/" & yil & ay & "/" & gun & ay & yil & ".xml"
xmlhttp.Open "GET", path, False
xmlhttp.send "at"
If xmlhttp.Status = 200 Then
    icerik = xmlhttp.responseText
    temizlik = Split(icerik, "<Currency CrossOrder=")
    For y = 0 To UBound(temizlik)
        If temizlik(y) Like "*=""" & Dovtip & "*" Then
            sonuclar = Split(temizlik(y), "</CurrencyName>")
            evn1 = Split(sonuclar(1), "<ForexBuying>")
            evn2 = Split(sonuclar(1), "<ForexSelling>")
            evn3 = Split(sonuclar(1), "<BanknoteBuying>")
            evn4 = Split(sonuclar(1), "<BanknoteSelling>")
            Select Case Tipi
                Case 1: evn = Split(evn1(1), "</")
                Case 2: evn = Split(evn2(1), "</")
                Case 3: evn = Split(evn3(1), "</")
                Case 4: evn = Split(evn4(1), "</")
            End Select
            Exit For
        End If
    Next y
End If
'Kuruş hanesini benim gibi virgül kullananlar için
Webdoviz = Replace(evn(0), ".", ",")

'Kuruş hanesini nokta kullananlar için
'Webdoviz = evn(0)
End Function
 
Son düzenleme:
Erkan Yılmaz

Erkan Yılmaz

Katılım
3 Kasım 2010
Mesajlar
219
Excel Vers. ve Dili
Excel 2016 - Türkçe
Sayın Halit3,

Çok teşekkür ederim. Şimdilik bir sorun yok gibi tam istediğim gibi ellerine yüreğine sağlık...
 
Erkan Yılmaz

Erkan Yılmaz

Katılım
3 Kasım 2010
Mesajlar
219
Excel Vers. ve Dili
Excel 2016 - Türkçe
halit3' Alıntı:
Teşekkürler iyi çalışmalar
Genişletmek için tıkla ...
Üstadım Merhaba,

Kodlar ile ilgili bir şey sormak istiyorum. Hafta sonu tatilleri ve resmi tatilleri için tamam çalışıyor sanırım kodlar ama bayram tatilleri içinde sıralı arka arkaya olan tatillerde bir sorun yaşar mıyım acaba?
 
halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,760
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Dini bayramlar hariç kodlar çalışması lazım
 
halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,760
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Koda dini bayramlarıda ekledim
Dini bayramları her yıl el ile güncellemek gerekiyor.
 
halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,760
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Bu kodu bir dene hatta geçmiş dini bayramları gününü de dene

Rich (BB code): 
DefVar E
Function Webdoviz(ByVal Tarih As Date, ByVal Dovtip As String, ByVal Tipi As Long) As Variant
Dim gun As String, ay As String, yil As String, path As String, kur As Double
Dim icerik As String, xmlhttp As Object, evn As Variant
Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
Application.Volatile
Dovtip = UCase(Dovtip)

atla1:

Tarih = CDate(Tarih)
If CDate(Tarih) = CDate(Format(Now, "dd.mm.yyyy")) And "15:30:00" >= CDate(Format(Now, "hh:nn")) Then
Tarih = Tarih - 1
End If

gun = Format(Val(Mid(Tarih, 1, 2)), "00")
ay = Format(Val(Mid(Tarih, 4, 2)), "00")
yil = Format(Val(Mid(Tarih, 7, 4)), "00")

path = "http://www.tcmb.gov.tr/kurlar/" & yil & ay & "/" & gun & ay & yil & ".xml"
xmlhttp.Open "GET", path, False
xmlhttp.send "at"


deg1 = Split(xmlhttp.responseText, "Page Not Found")
If UBound(deg1) > 0 Then
deg2 = Split(deg1(0), " ")
If UBound(deg2) > 0 Then
Tarih = Tarih - 1
GoTo atla1
End If
End If


If xmlhttp.Status = 200 Then
    icerik = xmlhttp.responseText
    temizlik = Split(icerik, "<Currency CrossOrder=")
    For y = 0 To UBound(temizlik)
        If temizlik(y) Like "*=""" & Dovtip & "*" Then
            sonuclar = Split(temizlik(y), "</CurrencyName>")
            evn1 = Split(sonuclar(1), "<ForexBuying>")
            evn2 = Split(sonuclar(1), "<ForexSelling>")
            evn3 = Split(sonuclar(1), "<BanknoteBuying>")
            evn4 = Split(sonuclar(1), "<BanknoteSelling>")
            Select Case Tipi
                Case 1: evn = Split(evn1(1), "</")
                Case 2: evn = Split(evn2(1), "</")
                Case 3: evn = Split(evn3(1), "</")
                Case 4: evn = Split(evn4(1), "</")
            End Select
            Exit For
        End If
    Next y
End If
'Kuruş hanesini benim gibi virgül kullananlar için
Webdoviz = Replace(evn(0), ".", ",")

'Kuruş hanesini nokta kullananlar için
'Webdoviz = evn(0)
End Function
 
Erkan Yılmaz

Erkan Yılmaz

Katılım
3 Kasım 2010
Mesajlar
219
Excel Vers. ve Dili
Excel 2016 - Türkçe
Üstadım Merhaba,

Son göndermiş olduğun kodu denedim ama excel makro çok yavaşladı ve çalışmadı diyebilirim.

Ama manuel eklemiş olduğun kodda bir sorun yok gibi şimdilik.
 
halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,760
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Bu kodlar KTF siz makro

1. bölüm için kod

Kod: 
Sub deneme1()

Tarih = Range("a1").Value
Dovtip = Range("a2").Value
Tipi = Range("a3").Value

Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
Application.Volatile
Dovtip = UCase(Dovtip)

atla1:

Tarih = CDate(Tarih)
If CDate(Tarih) = CDate(Format(Now, "dd.mm.yyyy")) And "15:30:00" >= CDate(Format(Now, "hh:nn")) Then
Tarih = Tarih - 1
End If

gun = Format(Val(Mid(Tarih, 1, 2)), "00")
ay = Format(Val(Mid(Tarih, 4, 2)), "00")
yil = Format(Val(Mid(Tarih, 7, 4)), "00")

path = "http://www.tcmb.gov.tr/kurlar/" & yil & ay & "/" & gun & ay & yil & ".xml"
xmlhttp.Open "GET", path, False
xmlhttp.send "at"

deg1 = Split(xmlhttp.responseText, "Page Not Found")
If UBound(deg1) > 0 Then
deg2 = Split(deg1(0), " ")
If UBound(deg2) > 0 Then
Tarih = Tarih - 1
GoTo atla1
End If
End If

If xmlhttp.Status = 200 Then
icerik = xmlhttp.responseText
temizlik = Split(icerik, "<Currency CrossOrder=")
For y = 0 To UBound(temizlik)
If temizlik(y) Like "*=""" & Dovtip & "*" Then
sonuclar = Split(temizlik(y), "</CurrencyName>")
evn1 = Split(sonuclar(1), "<ForexBuying>")
evn2 = Split(sonuclar(1), "<ForexSelling>")
evn3 = Split(sonuclar(1), "<BanknoteBuying>")
evn4 = Split(sonuclar(1), "<BanknoteSelling>")
Select Case Tipi
Case 1: evn = Split(evn1(1), "</")
Case 2: evn = Split(evn2(1), "</")
Case 3: evn = Split(evn3(1), "</")
Case 4: evn = Split(evn4(1), "</")
End Select
Exit For
End If
Next y
End If

Range("a4").Value = Replace(evn(0), ".", ",")

End Sub

2. bölüm için kod

Kod: 
Sub deneme2()

For i = 2 To Worksheets(ActiveSheet.Name).Cells(Rows.Count, "a").End(3).Row

Tarih = Cells(i, 1).Value
Dovtip = Cells(i, 2).Value
Tipi = Cells(i, 3).Value

Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
Application.Volatile
Dovtip = UCase(Dovtip)

atla1:

Tarih = CDate(Tarih)
If CDate(Tarih) = CDate(Format(Now, "dd.mm.yyyy")) And "15:30:00" >= CDate(Format(Now, "hh:nn")) Then
Tarih = Tarih - 1
End If

If Tarih > CDate(Format(Now, "dd.mm.yyyy")) Then GoTo atla2


gun = Format(Val(Mid(Tarih, 1, 2)), "00")
ay = Format(Val(Mid(Tarih, 4, 2)), "00")
yil = Format(Val(Mid(Tarih, 7, 4)), "00")

path = "http://www.tcmb.gov.tr/kurlar/" & yil & ay & "/" & gun & ay & yil & ".xml"
xmlhttp.Open "GET", path, False
xmlhttp.send "at"

deg1 = Split(xmlhttp.responseText, "Page Not Found")
If UBound(deg1) > 0 Then
deg2 = Split(deg1(0), " ")
If UBound(deg2) > 0 Then
Tarih = Tarih - 1
GoTo atla1
End If
End If

If xmlhttp.Status = 200 Then
icerik = xmlhttp.responseText
temizlik = Split(icerik, "<Currency CrossOrder=")
For y = 0 To UBound(temizlik)
If temizlik(y) Like "*=""" & Dovtip & "*" Then
sonuclar = Split(temizlik(y), "</CurrencyName>")
evn1 = Split(sonuclar(1), "<ForexBuying>")
evn2 = Split(sonuclar(1), "<ForexSelling>")
evn3 = Split(sonuclar(1), "<BanknoteBuying>")
evn4 = Split(sonuclar(1), "<BanknoteSelling>")
Select Case Tipi
Case 1: evn = Split(evn1(1), "</")
Case 2: evn = Split(evn2(1), "</")
Case 3: evn = Split(evn3(1), "</")
Case 4: evn = Split(evn4(1), "</")
End Select
Exit For
End If
Next y
End If

Cells(i, 4).Value = Replace(evn(0), ".", ",")

atla2:
Next i
MsgBox "işlem tamam"
End Sub
Yeni Bit Eşlem Resmi.jpg
 
R

Reo41

Altın Üye
Katılım
24 Aralık 2013
Mesajlar
79
Excel Vers. ve Dili
2010 Eng.
Altın Üyelik Bitiş Tarihi
15-11-2027
@Erkan Yılmaz bey dosyayı paylaşmanız mümkünmü? Biz de yararlanmak isteriz.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst