Sıralama yapma ve döviz kurlarını alma

[cenk1977]

Merhabalar arkadaşlar herkese çok selam forma yeni kayıt oldum super bir site farkındayım..

Yeni bir işe başladım ve müdürümün bana vermiş olduğu iş benim için çok zor ve çok vaktimi alacak yardım edebilirmisiniz.

 

[cenk1977]

Kasa adı altında verdiğim excel dosyasındaki kod kısmında yazan kodlar şeklinde başka bir dosyaya alt alta kopyalayıp yanlarına Merkez Bankası günlük kurları yazmam istendi.(dolar ve euro satış)
dosya içinde açıklamalı yazdım .Lütfen Yardım ben bunu manuel olarak 3 günde anca bitiririm

 

[Zeki Gürsoy]

Merhaba,

Yeni işiniz hayırlı olsun...

Dosyanızda sadece USD sütunu (G sütun) görünüyor. Aşağıdaki "TCMB_ICMAL" prosedurunu çalıştırdığınızda $ kurları gelecektir.

Örnekte Const SON As Long = 50 sabitiyle "50" nolu satıra kadar işlem yaptırdım. İsterseniz bunu 2000 ile değiştirin.

Kolay gelsin...

Sub TCMB_ICMAL()
Dim z As Long
On Error Resume Next

[COLOR=Blue][B]Const SON As Long = 50[/B][/COLOR]

Application.Caption = ""
ActiveWindow.Caption = "İşlem başladı bekleyin...  -  % 0"

    For z = 3 To SON
        DoEvents
        Cells(z, "g").Select
        Cells(z, "g") = GET_TCMB(Cells(z, "b"))
        ActiveWindow.Caption = _
            "İşlem sürüyor bekleyin...  -  % " & (z * 100) \ SON
    Next
    
    Application.Caption = Application.Name
    ActiveWindow.Caption = ActiveWorkbook.Name
    
    MsgBox "İşlem tamamlandı...", vbInformation
End Sub

Private Function GET_TCMB(ByRef tarih As Range) As Double
Const URL As String = "URL;http://www.tcmb.gov.tr/kurlar/"

DoEvents
   
Dim q As QueryTable, t As String, wee As Integer
Dim app As Application, wb As Workbook, sh As Worksheet

On Error Resume Next

Set app = CreateObject("Excel.Application")
Set wb = app.Workbooks.Add
Set sh = wb.Sheets(1)

    With app
        .DecimalSeparator = "."
        .ThousandsSeparator = ","
        .UseSystemSeparators = False
    End With

    wee = Weekday(CDate(tarih), vbMonday)
    Select Case wee
        Case 1
            t = Format$(CDate(tarih) - 3, "yyyymm") & _
                "/" & Format$(CDate(tarih) - 3, "ddmmyyyy") & ".html"
        Case 7
            t = Format$(CDate(tarih) - 2, "yyyymm") & _
                "/" & Format$(CDate(tarih) - 2, "ddmmyyyy") & ".html"
        Case Else
            t = Format$(CDate(tarih) - 1, "yyyymm") & _
                "/" & Format$(CDate(tarih) - 1, "ddmmyyyy") & ".html"
    End Select
    
    With sh
        .Cells.Delete
        
        Set q = .QueryTables.Add(URL & t, .Range("a1"))
        
        With q
            .WebFormatting = xlWebFormattingNone
            .WebPreFormattedTextToColumns = True
            .Refresh False
            .Delete
        End With
       
        GET_TCMB = .Range("d7").Value
    End With
        
    app.UseSystemSeparators = True
    
    wb.Close False
    app.Quit
    Set sh = Nothing
    Set wb = Nothing
    Set app = Nothing
    Set q = Nothing
End Function

 

[cenk1977]

çok teşekkürler zeki bey yanlız ben çok acemiyim bu formulu nereye yapıştıracam uygulamı anlatabilirmisiniz?