• DİKKAT

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

Kur Sorgu

B

Bakigemlik

Altın Üye
Katılım
16 Ocak 2013
Mesajlar
674
Excel Vers. ve Dili
2010 Türkçe
Merhaba,

A2 Hücremde =BUGÜN() formulü var her sabah açtığımda o günün tarihini otomatik yazıyor.Ben her gün exceli açtığımda bu tarihe göre web'den USD kur sorgulamasını ve "D2" hücresine yazmasını istiyorum, aynı şekilde de "E2" hücresine EURO kurunu yazmasını istiyorum

Desteğiniz için teşekkürler,

Saygılarımla,
 
Son düzenleme:
Ekli dosyayı inceleyebilirsiniz uygulama düzenini kendinize göre ayarlaya bilirsiniz
 

Ekli dosyalar

Makro formül kullanmak istemiyorum diyorsanız,
Çalışma kitabınızı açıp veri sekmesinden wep den butonuna tıklayın açılan adres çubuğuna Merkez bankasının link yazın almak istediğiniz verilerin yanında sarı ok vardır üzerine tıklayın formda al butonuna tıklayın hangi hücrelere veri çekeceğini soracak kendiniz belirleyin

iyi çalışmalar
 
halit3' Alıntı:
Alternatif link

Kod: 
http://www.excel.web.tr/f48/merkez-bankasyndan-doviz-kuru-cekmek-t141472.html
Genişletmek için tıkla ...

Halit Bey,

Öncelikle desteğiniz için teşekkürler,

ilgili linkteki kodu ek dosyada uygulamanız mümkün müdür,

Teşekkürler,

Saygılarımla,
 

Ekli dosyalar

Bakigemlik' Alıntı:
Halit Bey,

Öncelikle desteğiniz için teşekkürler,

ilgili linkteki kodu ek dosyada uygulamanız mümkün müdür,

Teşekkürler,

Saygılarımla,
Genişletmek için tıkla ...

Sizin eklediğiniz dosyada iki tarih arası uygulama var ve iki adet kur bilgisi mevcut
01.06.204-19.06.2014 tarihleri arasındaki kur bilgilerini nereye yazacak alt altamı yazacak anlamadım.

Buradaki uygulama tek bir gün ile sınırlı yani kur bilgilerini seçilen tarihi getiriyor iki tarih arası bilgileri getirmiyor.
 
halit3' Alıntı:
Sizin eklediğiniz dosyada iki tarih arası uygulama var ve iki adet kur bilgisi mevcut
01.06.204-19.06.2014 tarihleri arasındaki kur bilgilerini nereye yazacak alt altamı yazacak anlamadım.

Buradaki uygulama tek bir gün ile sınırlı yani kur bilgilerini seçilen tarihi getiriyor iki tarih arası bilgileri getirmiyor.
Genişletmek için tıkla ...

Merhaba Halit Bey,

B2 hücresinde =BUGÜN() formulü mevcut hergn sabah açılışta bu tarih değişeceği için sadece B2 hücresindeki tarihe göre D2 hücresine "USD" kuru "E2" hücresine "EURO" kuru getirmesini istiyorum,

Dönüşünüz ve desteğiniz için şimdiden teşekkürler,

Saygılarımla,
 
Bakigemlik' Alıntı:
Merhaba Halit Bey,

B2 hücresinde =BUGÜN() formulü mevcut hergn sabah açılışta bu tarih değişeceği için sadece B2 hücresindeki tarihe göre D2 hücresine "USD" kuru "E2" hücresine "EURO" kuru getirmesini istiyorum,

Dönüşünüz ve desteğiniz için şimdiden teşekkürler,

Saygılarımla,
Genişletmek için tıkla ...

Kod:

Kod: 
#If VBA7 Then

#Else

#End If

#If Win64 Then
Private Declare PtrSafe Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare PtrSafe Function InternetCheckConnection Lib "wininet.dll" Alias "InternetCheckConnectionA" (ByVal lpszUrl As String, ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
#Else
Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function InternetCheckConnection Lib "wininet.dll" Alias "InternetCheckConnectionA" (ByVal lpszUrl As String, ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
#End If

Sub kur_getir()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim IE As Object, URL As String

yer1 = "Bugün Bayram"
yer2 = "Bugün Tatil"
yer3 = "01.01.2005 dan küçük olamaz."
yer4 = "Veri alınacak tarih bugünden büyük olamaz."
yer5 = "Bugün işlem yok saat 15:30:00 dan sonra yeniden deneyiniz."
yer6 = "Sayfa Görüntülenemiyor veya Bu gün işlem yok"
yer7 = "internet bağlantısı yok"

URL = "http://www.tcmb.gov.tr/yeni/kurlar/kurlar_tr.php"

If (InternetCheckConnection(URL & "/", &H1, 0&) = 0) Then MsgBox yer7:  GoTo atla


Tarih = CDate((Format(Cells(2, 2).Value, "dd.mm.yyyy")))
Range("D2:E2").ClearContents

If IsDate(Tarih) = False Then MsgBox "Tarih Yanlış": GoTo atla

If Tarih < CDate(Format("01.01.2005", "dd.mm.yyyy")) Then MsgBox yer3: GoTo atla
If CDate(Tarih) > Format(Now, "dd/mm/yyyy") Then MsgBox yer4: GoTo atla


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: MsgBox yer1: GoTo atla
If "Cumartesi" = Format(Tarih, "dddd") Or "Pazar" = Format(Tarih, "dddd") Then MsgBox yer2: GoTo atla
If CDate(Tarih) = CDate(Format(Now, "dd.mm.yyyy")) And "15:30:00" >= CDate(Format(Now, "hh:nn")) Then MsgBox yer5: GoTo atla

Set IE = CreateObject("InternetExplorer.Application")
With IE
.Navigate URL
.Visible = 0
apiShowWindow IE.hWnd, 2

deg1 = Format(Val(Mid(Tarih, 1, 2)), "00")
deg2 = Format(Val(Mid(Tarih, 4, 2)), "00")
deg3 = Format(Val(Mid(Tarih, 7, 4)), "00")

URL1 = "http://www.tcmb.gov.tr/kurlar/" & deg3 & deg2 & "/" & deg1 & deg2 & deg3 & ".html"
.Navigate URL1

Do Until IE.ReadyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop

Set html_tba = IE.Document.getElementsByTagName("Body")
adres = Replace(Replace(WorksheetFunction.Trim(html_tba(0).InnerText), Chr(13), ""), Chr(10), " ")

If UBound(Split(adres, "Sayfa Görüntülenemedi")) > 0 Then MsgBox yer6: GoTo atla1
'If Mid(Replace(adres, " ", ""), 1, 20) = "SayfaGörüntülenemedi" Then MsgBox yer6: GoTo atla1

ReDim aranan(2)
aranan(1) = "USD/TRY"
aranan(2) = "EUR/TRY"

'döviz alış için 1 döviz satış için 2 efktif alış için 3 efektif satış için 4  yazınız.
bulunan_satir = 2

For j = 1 To 2

deg1 = Split(adres, aranan(j))
If UBound(deg1) > 0 Then
deg2 = Split(deg1(1), " ")
k = 0
For i = 1 To 10
If IsNumeric(deg2(i)) = True Then
k = k + 1
If k = bulunan_satir Then
Cells(2, 3 + j).Value = deg2(i)
Exit For
End If
End If
Next

End If

Next

atla1:

IE.Quit: Set IE = Nothing


End With
atla:

MsgBox "işlem tamam"
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
 
halit3' Alıntı:
Kod:
Kod: 
Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function InternetCheckConnection Lib "wininet.dll" Alias "InternetCheckConnectionA" (ByVal lpszUrl As String, ByVal dwFlags As Long, ByVal dwReserved As Long) As Long



Sub kur_getir()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim IE As Object, URL As String

yer1 = "Bugün Bayram"
yer2 = "Bugün Tatil"
yer3 = "01.01.2005 dan küçük olamaz."
yer4 = "Veri alınacak tarih bugünden büyük olamaz."
yer5 = "Bugün işlem yok saat 15:30:00 dan sonra yeniden deneyiniz."
yer6 = "Sayfa Görüntülenemiyor veya Bu gün işlem yok"
yer7 = "internet bağlantısı yok"

URL = "http://www.tcmb.gov.tr/yeni/kurlar/kurlar_tr.php"

If (InternetCheckConnection(URL & "/", &H1, 0&) = 0) Then MsgBox yer7:  GoTo atla


Tarih = CDate((Format(Cells(2, 2).Value, "dd.mm.yyyy")))
Range("D2:E2").ClearContents

If IsDate(Tarih) = False Then MsgBox "Tarih Yanlış": GoTo atla

If Tarih < CDate(Format("01.01.2005", "dd.mm.yyyy")) Then MsgBox yer3: GoTo atla
If CDate(Tarih) > Format(Now, "dd/mm/yyyy") Then MsgBox yer4: GoTo atla


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: MsgBox yer1: GoTo atla
If "Cumartesi" = Format(Tarih, "dddd") Or "Pazar" = Format(Tarih, "dddd") Then MsgBox yer2: GoTo atla
If CDate(Tarih) = CDate(Format(Now, "dd.mm.yyyy")) And "15:30:00" >= CDate(Format(Now, "hh:nn")) Then MsgBox yer5: GoTo atla

Set IE = CreateObject("InternetExplorer.Application")
With IE
.Navigate URL
.Visible = 0
apiShowWindow IE.hWnd, 2

deg1 = Format(Val(Mid(Tarih, 1, 2)), "00")
deg2 = Format(Val(Mid(Tarih, 4, 2)), "00")
deg3 = Format(Val(Mid(Tarih, 7, 4)), "00")

URL1 = "http://www.tcmb.gov.tr/kurlar/" & deg3 & deg2 & "/" & deg1 & deg2 & deg3 & ".html"
.Navigate URL1

Do Until IE.ReadyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop

Set html_tba = IE.Document.getElementsByTagName("Body")
adres = Replace(Replace(WorksheetFunction.Trim(html_tba(0).InnerText), Chr(13), ""), Chr(10), " ")

If UBound(Split(adres, "Sayfa Görüntülenemedi")) > 0 Then MsgBox yer6: GoTo atla1
'If Mid(Replace(adres, " ", ""), 1, 20) = "SayfaGörüntülenemedi" Then MsgBox yer6: GoTo atla1

ReDim aranan(2)
aranan(1) = "USD/TRY"
aranan(2) = "EUR/TRY"


For j = 1 To 2

deg1 = Split(adres, aranan(j))
If UBound(deg1) > 0 Then
deg2 = Split(deg1(1), " ")
Cells(2, 3 + j).Value = deg2(4)
Cells(2, 3 + j).Value = deg2(5)
End If

Next

atla1:

IE.Quit: Set IE = Nothing


End With
atla:

MsgBox "işlem tamam"
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
Genişletmek için tıkla ...

Emeğiniz ve ilginiz için çok teşekkürler,
 
halit3 üstadım kod için teşekkürler. Aşağıdaki satırda sanırım FORMAT yazılı kısımdan ötürü hata veriyor. Bunun nedeni nedir acaba ! veya nasıl giderilebilir ?

Tarih = CDate((FORMAT(Cells(2, 2).Value, "dd.mm.yyyy")))
 
Ofis 2016 için bölgesel ayarlarınızı kontrol ediniz.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst