Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

22 Haziran 2010 Salı

Eğilim Analizi (Trend Analysis)

 
'Module1
 
'A) VBProject References List
    'Name: VBA, Description: Visual Basic For Applications, FullPath: C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
    'Name: Excel, Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE
    'Name: stdole, Description: OLE Automation, FullPath: C:\WINDOWS\system32\stdole2.tlb
    'Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
'B) TREND ANALYSIS Resource References
    'Prf. Dr. Üzeyme DOĞAN; Üretim Planlaması Kontrolü Dersi

Private i As Integer
Private Sayfa As Worksheet
Private Eleman As Range
Sub Trend_Analizi_Tablosu() 'Table of Trend Analysis
    On Error Resume Next
    For Each Sayfa In ThisWorkbook.Sheets
        If Sayfa.Name = "Trend Analizi" Then GoTo Devam
    Next Sayfa
    ThisWorkbook.Worksheets.Add Sheets(1)
    ActiveSheet.Name = "Trend Analizi"
Devam:
    Sheets("Trend Analizi").Select
    ActiveSheet.Unprotect
    Cells.Select
    Selection.Delete Shift:=xlUp   
    Call Alan_Formatla("A1", "ID", "Period")
    Range("A2").FormulaR1C1 = ""
    For i = 1 To 24
        With Range("A3:A26")
            .Cells(i, 1) = i
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
        End With
    Next i
    Call Alan_Formatla("B1", "X(1000)", "Argument")
    Call Alan_Formatla("B2", "Tahmin [Estimate]", "Estimate")
    For Each Eleman In Range("B3:B26")
        If Eleman.Row < 14 Then
            Eleman.Value = VBA.Rnd * 100
        Else
            Eleman.Value = ""
        End If
    Next Eleman
    Call Alan_Formatla("C2", "Fiili [Actual]", "Actual")
    For Each Eleman In Range("C3:C26")
        If Eleman.Row < 13 Then
            Eleman.Value = VBA.Rnd * 100
        Else
            Eleman.Value = ""
        End If
    Next Eleman
    Call Alan_Formatla("D1", "t(X)", "Cumulative Argument")
    Range("D2").FormulaR1C1 = ""
    Range("D3").FormulaR1C1 = "=IF(RC[-1]=0,RC[-2],RC[-1])"
    Range("D4:D26").FormulaR1C1 = "=R[-1]C+IF(RC[-1]=0,RC[-2],RC[-1])"
    Call Alan_Formatla("E1", "Y(1000000)", "Dependent Variable")
    Call Alan_Formatla("E2", "Tahmin [Estimate]", "Estimate")
    Range("E3:E26").FormulaR1C1 = "=RC[9]"
    Range("F1").FormulaR1C1 = ""
    Call Alan_Formatla("F2", "Fiili [Actual]", "Actual")
    For Each Eleman In Range("F3:F26")
        If Eleman.Row < 13 Then
            Eleman.Value = VBA.Rnd * 100
        Else
            Eleman.Value = ""
        End If
    Next Eleman
    Call Alan_Formatla("G1", "t(Y)", "Cumulative Dependent Variable")
    Range("G2").FormulaR1C1 = ""
    Range("G3").FormulaR1C1 = "=IF(RC[-1]=0,RC[-2],RC[-1])"
    Range("G4:G26").FormulaR1C1 = "=R[-1]C+IF(RC[-1]=0,RC[-2],RC[-1])"
    Range("H1").FormulaR1C1 = "X²"
    Range("H2").FormulaR1C1 = ""
    Range("H3:H26").FormulaR1C1 = "=IF(RC[-5]=0,RC[-6]^2,RC[-5]^2)"
    Range("I1").FormulaR1C1 = "t(X²)"
    Range("I2").FormulaR1C1 = ""
    Range("I3").FormulaR1C1 = "=RC[-1]"
    Range("I4:I26").FormulaR1C1 = "=R[-1]C+RC[-1]"
    Range("J1").FormulaR1C1 = "XY"
    Range("J2").FormulaR1C1 = ""
    Range("J3:J26").FormulaR1C1 = "=IF(RC[-7]=0,RC[-8],RC[-7])*IF(RC[-4]=0,RC[-5],RC[-4])"
    Range("K1").FormulaR1C1 = "t(XY)"
    Range("K2").FormulaR1C1 = ""
    Range("K3").FormulaR1C1 = "=RC[-1]"
    Range("K4:K26").FormulaR1C1 = "=R[-1]C+RC[-1]"
    Call Alan_Formatla("L1", "b", "b= (ID * t(XY) - t(X) * t(Y)) / (ID * t(X²) - t(X)²)")
    Range("L2").FormulaR1C1 = ""
    Range("L3:L26").FormulaR1C1 = "=IF((RC[-11]*RC[-3]-RC[-8]^2)=0,0,(RC[-11]*RC[-1]-RC[-8]*RC[-5])/(RC[-11]*RC[-3]-RC[-8]^2))"
    Call Alan_Formatla("M1", "a", "a= (t(Y) / ID) - b * (t(X) / ID)")
    Range("M2").FormulaR1C1 = ""
    Range("M3:M26").FormulaR1C1 = "=(RC[-6]/RC[-12])-RC[-1]*(RC[-9]/RC[-12])"
    Call Alan_Formatla("N1", "y", "y= (a[ID-1] + b[ID-1] * X[ID])")
    Range("N2").FormulaR1C1 = ""
    Range("N3").FormulaR1C1 = ""
    Range("N4:N12").FormulaR1C1 = "=R[-1]C[-1]+RC[-11]*R[-1]C[-2]"
    Range("N13:N26").FormulaR1C1 = "=R[-1]C[-1]+IF(RC[-11]=0,RC[-12],RC[-11])*R[-1]C[-2]"
    Columns("A:A").ColumnWidth = 4
    Columns("B:N").ColumnWidth = 10
    With Range("A1:N2")
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Range("A1:A2, B1:C1, B2, C2, D1:D2, E1:F1, E2, F2, G1:G2, H1:H2, I1:I2, J1:J2, K1:K2, L1:L2, M1:M2, N1:N2")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = True
        .ReadingOrder = xlContext
        .MergeCells = True
        .Merge
    End With
    Range("B3:N26").NumberFormat = "#,##0.00"
    With Range("B3:C26, F3:F26")
        With .Font
            .Name = "Arial Narrow"
            .FontStyle = "Normal"
            .Size = 10
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = 32
        End With
        .Locked = False
        .FormulaHidden = False
    End With
    Call Kenar_Formatla("A1:N26")
    Call Kenar_Formatla("A1:N2")
    With Range("A1:N26").Font
        .Name = "Arial Narrow"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
    End With
    Rows("1:1").Insert Shift:=xlDown
    With Range("A1:N1")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
        .Merge
        With .Font
            .Name = "Arial Narrow"
            .Size = 14
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = 2
            .Bold = True
        End With
        With .Interior
            .ColorIndex = 5
            .Pattern = xlSolid
        End With
        .FormulaR1C1 = "EĞİLİM ANALİZİ (TREND ANALYSIS)"
    End With
    With Range("A2:N3").Interior
        .Pattern = xlLightUp
        .PatternThemeColor = xlThemeColorDark1
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .PatternTintAndShade = -0.14996795556505
    End With
    Call Grafik_Ekle
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Range("B14").Select
End Sub
Private Sub Alan_Formatla(ByVal hAdres As String, hAd As String, hComment As String)

    On Error Resume Next
    With Range(hAdres)
        .FormulaR1C1 = hAd
        .AddComment
        .Comment.Visible = False
        .Comment.Text Text:=hComment & Chr(10) & ""
        With .Comment.Shape
            .ScaleWidth 2.09, msoFalse, msoScaleFromTopLeft
            .ScaleWidth 1.23, msoFalse, msoScaleFromTopLeft
            .ScaleWidth 0.87, msoFalse, msoScaleFromTopLeft
            .ScaleHeight 0.27, msoFalse, msoScaleFromTopLeft
        End With
    End With
End Sub
Private Sub Kenar_Formatla(ByVal hAdres As String)

    On Error Resume Next
    With Range(hAdres)
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        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 Grafik_Ekle()

    On Error Resume Next
    ActiveSheet.Shapes.AddChart.Select
    With Selection
        .Left = 0
        .Top = 368
        .Width = 650
    End With
    With ActiveChart
        .ChartType = xlLine
        For i = 1 To 24
            .SeriesCollection(1).Delete
        Next i
        .SeriesCollection.NewSeries
        With .SeriesCollection(1)
            .Name = "=""X Tahmin [Estimate]"""
            .Values = "='Trend Analizi'!$B$4:$B$27"
        End With
        .SeriesCollection.NewSeries
        With .SeriesCollection(2)
            .Name = "=""X Fiili [Actual]"""
            .Values = "='Trend Analizi'!$C$4:$C$27"
            .Trendlines.Add
            .Trendlines(1).Select
            With Selection.Format.Line
                .Visible = msoTrue
                .Weight = 6
                .ForeColor.RGB = VBA.RGB(0, 255, 0)
            End With
        End With
        .SeriesCollection.NewSeries
        With .SeriesCollection(3)
            .Name = "=""Y Tahmin [Estimate]"""
            .Values = "='Trend Analizi'!$E$4:$E$27"
        End With
        .SeriesCollection.NewSeries
        With .SeriesCollection(4)
            .Name = "=""Y Fiili [Actual]"""
            .Values = "='Trend Analizi'!$F$4:$F$27"
            .Trendlines.Add
            .Trendlines(1).Select
            With Selection.Format.Line
                .Visible = msoTrue
                .Weight = 6
                .ForeColor.RGB = VBA.RGB(0, 0, 255)
            End With
        End With
        For i = 1 To 24
            .SeriesCollection(5).Delete
        Next i
    End With
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