Merkez Bankası Günlük Kur bilgisi çekme

[Onur5k]

Bir excel sayfasına günlük merkez bankası sitesinden kur bilgisi çekilmek istenmektedir. Veri- Dış Veri AL - WEb'den seçenekleri ile Merkez bankasının https://www.tcmb.gov.tr/wps/wcm/connect/tr/tcmb+tr/main+page+site+area/bugun internet adresinden seçim yapılıp tabloya çekildiğinde kurlar değil sadece sitenin başındaki Banka Hakkında - Temel faaliyetler gibi bilgiler geliyor. Kur bilgisi alınamıyor.

Eski konu başlıklarını inceledim ancak Merkez Bankası internet sitesini güncellediği için verilen tüm çözümler geçersiz kalmış gibi.

İlgili sorun çözümü konusunda yardımlarınızı rica ederim.

Saygılarımla

 

[rabbace]

Merhaba,

Aşağıdaki siteden alınız.

http://www.tcmb.gov.tr/kurlar/today.xml

 

[Haluk]

Aşağıdaki linkte hazır dosya var ....

https://www.excel.web.tr/threads/xmlhttp-ve-regexp-ile-tcmb-guenluek-doeviz-kurlari.174576/

.

 

[Onur5k]

çok yararlı oldu teşekkürler Haluk Bey. Yaptığım çalışmaya direk entegre edebileceğim bilgiler var. Ancak bir firmanın güncel borç durumu için günlük kurlara bağlı otomatik formüller var. Bu çalışmayı Verileri AL butonu ile değilde dosya açıldığında otomatik olarak güncelleyebilecek şekilde kullanma şansımız var mıdır?

Bilgilerinizi rica ederim.

SYG

 

[Haluk]

Dosyanın ThisWorkbook modülüne aşağıdaki kodu yerleştirin, dosyayı kaydedip kapatın.

Dosya açıldığında, otomatik olarak "Test" isimli makro çalışacak ve ilgili veriler alınacaktır.

Private Sub Workbook_Open()
    Call Test
End Sub

.

 

[muhasebeciyiz]

Sub deneme()
Application.ScreenUpdating = False
Dim alan As Range
Cells.Clear
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.tcmb.gov.tr/kurlar/today.xml", Destination:=Range("$A$1"))
.Name = "today_1"
.Refresh BackgroundQuery:=False
End With
Range("AB1000").Value = "10000"
Range("AB1000").Copy
Set alan = Range("D3:G20")
alan.Select
For Each evn In alan
If Left(evn.Value, 2) = 10 Then
evn.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
evn.Value = CDbl(evn.Value)
ElseIf Left(evn.Value, 1) > 0 Then
evn.PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide, SkipBlanks:=False, Transpose:=False
ElseIf Left(evn.Value, 1) = 0 Then
evn.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, SkipBlanks:=False, Transpose:=False
evn.PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide, SkipBlanks:=False, Transpose:=False
End If
Next evn
Range("D25:26,D28,D30:37,D40").PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide, SkipBlanks:=False, Transpose:=False
Range("D27,D29,D38,D41").Replace What:=".", Replacement:=","
Range("D44").Value = Range("D44").Value / 100000
Range("D45").Value = Range("D45").Value / 10000
Range("D25:41").HorizontalAlignment = xlRight
Application.CutCopyMode = False
Columns("D:G").NumberFormat = "#,##0.0000"
Range("D44").NumberFormat = "#,##0.00000"
Range("D39").NumberFormat = "#,##0"
Cells.Font.Size = 8: Columns.AutoFit: Range("A1").Select
Application.ScreenUpdating = True
End Sub

Not: Kod alıntıdır.Yapanın eline sağlık