Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Aralık 2009 Pazar

İç Verim Oranı (Internal Rate Of Return) [IRR][Newton Simplex Method] Hesabı

 
'Module1
 
Option Explicit
Dim GOran As Range
Dim DOran As Range
Dim TNV As Range
Dim TNPV As Range
Dim Sayfa As Worksheet
Sub IRR_Sayfa_Ekle() 'Add IRR Sheet   
    On Error Resume Next
    For Each Sayfa In ThisWorkbook.Sheets
        If Sayfa.Name = "IRRHesapla" Then GoTo Sayfa_Ekle
    Next Sayfa
    ThisWorkbook.Worksheets.Add Sheets(1)
    ActiveSheet.Name = "IRRHesapla"
Sayfa_Ekle:
    Sheets("IRRHesapla").Select
    ActiveSheet.Unprotect
    Cells.Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    Columns("A:A").ColumnWidth = 8
    Columns("B:B").ColumnWidth = 12
    Columns("C:C").ColumnWidth = 12
    Columns("D:D").ColumnWidth = 12
    Columns("E:E").ColumnWidth = 12
    Columns("F:F").ColumnWidth = 12
    Columns("G:G").ColumnWidth = 12
    Columns("H:H").ColumnWidth = 12
    Range("7:7,2:2").RowHeight = 6
    Range("1:1").RowHeight = 24
    Range("8:8").RowHeight = 66
    With Range("A1:H1")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = True
        .ReadingOrder = xlContext
        .MergeCells = True
        .Font.ColorIndex = 2
        .Interior.ColorIndex = 5
        With .Cells(1, 1)
            .FormulaR1C1 = "YATIRIMLARIN GERİ DÖNÜŞÜNE AİT İÇ VERİM ORANI (Internal Rate Of Return) [IRR]"
            With .Characters(Start:=1, Length:=77).Font
                .Name = "Arial Narrow"
                .FontStyle = "Kalın"
                .Size = 11
                .Underline = xlUnderlineStyleNone
                .ColorIndex = 2
            End With
        End With
    End With
    With Range("E3:G3, E4:G4, E5:G5, E6:G6")
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = True
        .ReadingOrder = xlContext
        .MergeCells = True
        .Cells(1, 1).FormulaR1C1 = "Yatırım Tarihi (to) [Investment Date (to)]"
        .Cells(2, 1).FormulaR1C1 = "Düzeltilen Günlük IRR [Corrected Daily IRR]"
        .Cells(3, 1).FormulaR1C1 = "Kullanılan Günlük IRR [Used Daily IRR]"
        .Cells(4, 1).FormulaR1C1 = "Yıllık IRR [Annual IRR]"
    End With
    With Range("B9:B21")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = True
        .ReadingOrder = xlContext
        .MergeCells = False
        .NumberFormat = "dd/mmm/yyyy"
    End With
    With Range("H3:H6")
        .Cells(1, 1).FormulaR1C1 = "=R[6]C[-6]"
        .Cells(1, 1).NumberFormat = "dd/mmm/yyyy"
        .Cells(2, 1).FormulaR1C1 = "=R[1]C/IF((R[18]C[-3]-R[18]C)>0,(R[18]C[-3]-R[18]C)/R[18]C[-3],-(R[18]C[-3]-R[18]C)/R[18]C[-3])"
        .Cells(2, 1).NumberFormat = "0.000000%"
        .Cells(3, 1).FormulaR1C1 = "0.1%"
        .Cells(3, 1).NumberFormat = "0.000000%"
        .Cells(4, 1).FormulaR1C1 = "=R[-1]C * 365"
        .Cells(4, 1).NumberFormat = "0.00%"
        With .Font
            .Bold = True
            .Name = "Arial Narrow"
            .FontStyle = "Normal"
            .Size = 10
            .ColorIndex = xlAutomatic
        End With
        With .Cells(3, 1)
            .Font.ColorIndex = 5
            .Locked = False
        End With
    End With
    Call Çizgi_Çiz("E3:H6")
    Call Çizgi_Çiz("H3:H6")
    With Range("A8:H8")
        .Cells(1, 1).FormulaR1C1 = "Dönem [Period]"
        .Cells(1, 2).FormulaR1C1 = "Dönem Tarih [Period Date]"
        .Cells(1, 3).FormulaR1C1 = "Nakit Çıkışı [Cash Pay]"
        .Cells(1, 4).FormulaR1C1 = "Nakit Girişi [Cash Flow]"
        .Cells(1, 5).FormulaR1C1 = "Net Nakit Girişi [Net Cash Inflow]"
        .Cells(1, 6).FormulaR1C1 = "Dönem Gün [Period Day]"
        .Cells(1, 7).FormulaR1C1 = "Dönem İskonto Katsayısı [Period Discount Factor]"
        .Cells(1, 8).FormulaR1C1 = "İskontolu Net Nakit Girişi [Discounted Net Cash Inflow]"
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = True
        .ReadingOrder = xlContext
        .MergeCells = False
        With .Font
            .Bold = False
            .Name = "Arial Narrow"
            .FontStyle = "Normal"
            .Size = 10
            .ColorIndex = xlAutomatic
        End With
    End With
    With Range("A9:A22")
        .Cells(1, 1).FormulaR1C1 = "t0"
        .Cells(2, 1).FormulaR1C1 = "t1"
        .Cells(3, 1).FormulaR1C1 = "t2"
        .Cells(4, 1).FormulaR1C1 = "t3"
        .Cells(5, 1).FormulaR1C1 = "t4"
        .Cells(6, 1).FormulaR1C1 = "t5"
        .Cells(7, 1).FormulaR1C1 = "t6"
        .Cells(8, 1).FormulaR1C1 = "t7"
        .Cells(9, 1).FormulaR1C1 = "t8"
        .Cells(10, 1).FormulaR1C1 = "t9"
        .Cells(11, 1).FormulaR1C1 = "t10"
        .Cells(12, 1).FormulaR1C1 = "t11"
        .Cells(13, 1).FormulaR1C1 = "t12"
        .Cells(14, 1).FormulaR1C1 = "Toplam"
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = True
        .ReadingOrder = xlContext
        .MergeCells = False
        With .Font
            .Bold = False
            .Name = "Arial Narrow"
            .FontStyle = "Normal"
            .Size = 10
            .ColorIndex = xlAutomatic
        End With
    End With
    Range("E9:E21").FormulaR1C1 = "=+RC[-1]-RC[-2]"
    Range("C22, D22, E22, H22").FormulaR1C1 = "=SUM(R[-13]C:R[-1]C)"
    Range("F9:F21").FormulaR1C1 = "=+RC[-4]-R3C8"
    Range("G9:G21").FormulaR1C1 = "=(1+R5C8)^RC[-1]"
    Range("H9:H21").FormulaR1C1 = "=RC[-3]/RC[-1]"
    Range("B22, F22:G22").Interior.ColorIndex = 15
    With Range("A9:H22").Font
        .Name = "Arial Narrow"
        .Size = 10
    End With
    With Range("B9:D21")
        With .Font
            .Name = "Arial Narrow"
            .FontStyle = "Normal"
            .Size = 10
            .ColorIndex = 5
        End With
        .Locked = False
    End With
    Range("B9:B21").NumberFormat = "dd/mmm/yyyy"
    Range("C9:E22").NumberFormat = "#,##0.00"
    Range("F9:F21").NumberFormat = "#,##0"
    Range("G9:G21").NumberFormat = "#,##0.000000"
    Range("H9:H22").NumberFormat = "#,##0.00"
    Call Çizgi_Çiz("A8:H22")
    Call Çizgi_Çiz("A8:H8")
    Call Çizgi_Çiz("A22:H22")
    With ActiveWorkbook
        .Names("SDOran").Delete
        .Names("SGOran").Delete
        .Names("STNPV").Delete
        .Names("STNV").Delete
        .Names.Add Name:="STNV", RefersToR1C1:="=IRRHesapla!R22C5"
        .Names.Add Name:="STNPV", RefersToR1C1:="=IRRHesapla!R22C8"
        .Names.Add Name:="SDOran", RefersToR1C1:="=IRRHesapla!R4C8"
        .Names.Add Name:="SGOran", RefersToR1C1:="=IRRHesapla!R5C8"
    End With
    With ActiveSheet
        .Shapes.Range(Array("CButton1")).Cut
        .Buttons.Add(16, 40.25, 182.25, 31.75).Select
    End With
    With Selection
        .Name = "CButton1"
        .OnAction = "Hesaplanan_IRR"
        .Characters.Text = "IRR Hesapla [IRR Calculate]"
        With .Characters(Start:=1, Length:=11).Font
            .Name = "Arial Narrow"
            .FontStyle = "Normal"
            .Size = 12
            .Bold = True
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .Color = vbRed
        End With
    End With
    With Range("H22")
        .FormulaR1C1 = "=ROUND(SUM(R[-13]C:R[-1]C),2)"
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, Formula1:="=0"
        .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior
            .Pattern = xlLightUp
            .PatternColor = 255
            .ColorIndex = xlAutomatic
            .PatternTintAndShade = 0
        End With
        .FormatConditions(1).StopIfTrue = False
    End With
    With Range("E3:G6,A8:H8,A22").Interior
        .Pattern = xlLightUp
        .PatternThemeColor = xlThemeColorDark1
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .PatternTintAndShade = -0.14996795556505
    End With
    Range("B9").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Call Örnek_Veriler
End Sub
Private Sub Çizgi_Çiz(hAdres As String) 'Draw Border

    On Error Resume Next
    With Range(hAdres)
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    End With
End Sub
Private Sub Örnek_Veriler() 'Sample DataBase

    On Error Resume Next
    Range("B9:D21").ClearContents
    Range("B9").FormulaR1C1 = "1/1/2009"
    Range("B10").FormulaR1C1 = "1/1/2010"
    Range("B11").FormulaR1C1 = "1/1/2011"
    Range("B12").FormulaR1C1 = "1/1/2012"
    Range("B13").FormulaR1C1 = "1/1/2013"
    Range("B14").FormulaR1C1 = "1/1/2014"
    Range("B15").FormulaR1C1 = "1/1/2015"
    Range("B16").FormulaR1C1 = "1/1/2016"
    Range("B17").FormulaR1C1 = "1/1/2017"
    Range("B18").FormulaR1C1 = "1/1/2018"
    Range("B19").FormulaR1C1 = "1/1/2019"
    Range("B20").FormulaR1C1 = "1/1/2020"
    Range("B21").FormulaR1C1 = "1/1/2021"
    Range("C9").FormulaR1C1 = "70000"
    Range("C12").FormulaR1C1 = "6000"
    Range("C15").FormulaR1C1 = "4200"
    Range("D10").FormulaR1C1 = "12000"
    Range("D11").FormulaR1C1 = "15000"
    Range("D12").FormulaR1C1 = "18000"
    Range("D13").FormulaR1C1 = "21000"
    Range("D14").FormulaR1C1 = "26000"
    Range("D15").FormulaR1C1 = "34000"
    Range("D16").FormulaR1C1 = "25800"
    Range("D17").FormulaR1C1 = "32950"
    Range("D18").FormulaR1C1 = "19100"
    Range("D19").FormulaR1C1 = "6850"
    Range("D20").FormulaR1C1 = "9400"
    Range("D21").FormulaR1C1 = "8700"
End Sub
Private Sub Hesaplanan_IRR() 'IRR Calculate

    On Error Resume Next
    Set GOran = ThisWorkbook.Sheets("IRRHesapla").Range("SGOran")
    Set DOran = ThisWorkbook.Sheets("IRRHesapla").Range("SDOran")
    Set TNV = ThisWorkbook.Sheets("IRRHesapla").Range("STNV")
    Set TNPV = ThisWorkbook.Sheets("IRRHesapla").Range("STNPV")
    GOran.FormulaR1C1 = "0.001"
    Do While Not VBA.Round(TNPV.Value, 2) = 0
        DOran.Copy
        GOran.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Loop
    Application.CutCopyMode = False
    Range("H22").Select
End Sub


Hiç yorum yok:

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul