Анализ отчетности v0.1

Опубликовано автор kos20 
Sub RunTSP()
 
Set shdto = ActiveWorkbook.Worksheets(1)
Set shdfrom = ActiveWorkbook.Worksheets(2)
 
For Each r In Range("KeyStrings")
 
Next r
End Sub
 
Function MyFormatMLN(ByVal number As Double) As Variant
         MyFormatMLN = FormatNumber(number / 1000, 2) & " млн. руб."
End Function
 
Sub test2()
On Error Resume Next
Set shdto = ActiveWorkbook.Worksheets(1)
Set shdfrom = ActiveWorkbook.Worksheets(2)
 
YearRow = shdfrom.Range("1:30").Find("Наименование показателя").Row
LastColumn = shdfrom.Cells(YearRow, Columns.count).End(xlToLeft).Column  '7 'shdfrom.Cells.SpecialCells(xlLastCell).Column
InterestPayable = 1
 
If shdto.Range("B4").Value = "Платежная дисциплина Дебитора." Then
    shdto.Range("E10:F25") = ""
End If
 
For i = 1 To 100
    '-11 строка -------------------------------
        If shdfrom.Range("B" & i) = 2400 Then
            If shdfrom.Cells(i, LastColumn) < 0 Then
                shdto.Range("E11") = "Убыток по итогам " & shdfrom.Cells(YearRow, LastColumn) & " года составляет " & MyFormatMLN(shdfrom.Cells(i, LastColumn))
            Else
                shdto.Range("E11") = ""
                shdto.Range("F11") = "Прибыль по итогам " & shdfrom.Cells(YearRow, LastColumn) & " года составляет " & MyFormatMLN(shdfrom.Cells(i, LastColumn))
            End If
        End If
    '-----------------------------------------
 
    '-12 строка -------------------------------
        Select Case shdfrom.Range("B" & i)
            Case 1410: Debt = shdfrom.Cells(i, LastColumn)
                       Debt0 = shdfrom.Cells(i, LastColumn).Offset(0, -1)
                GoTo Nexti
            Case 1510: Debt = Debt + shdfrom.Cells(i, LastColumn)
                       Debt0 = Debt0 + shdfrom.Cells(i, LastColumn).Offset(0, -1)
                GoTo Nexti
            Case 2110: Sales = shdfrom.Cells(i, LastColumn)
                       Sales0 = shdfrom.Cells(i, LastColumn).Offset(0, -1)
                GoTo Nexti
            Case 2200: EBIT = shdfrom.Cells(i, LastColumn)
                GoTo Nexti
            Case 2330: InterestPayable = shdfrom.Cells(i, LastColumn)
                GoTo Nexti
         End Select
 
 
    '-----------------------------------------
 
    '13 строка -------------------------------
     If shdfrom.Range("B" & i) = 1300 Then
          NA = shdfrom.Cells(i, LastColumn)
          NA0 = shdfrom.Cells(i, LastColumn).Offset(0, -1)
            If (NA - NA0) < 0 Then
                shdto.Range("E13") = "ЧА снизились на " & MyFormatMLN(NA - NA0) & " (" & FormatPercent(NA / NA0 - 1, 2) & ")"
            Else
                shdto.Range("E13") = ""
                shdto.Range("F13") = "ЧА Увеличилась на " & MyFormatMLN(NA - NA0) & " (" & FormatPercent(NA / NA0 - 1, 2) & ")"
            End If
        End If
    '-----------------------------------------
 
    '-14 строка -------------------------------
    If shdfrom.Range("B" & i) = 1520 Then
        KZ = shdfrom.Cells(i, LastColumn)
        KZ0 = shdfrom.Cells(i, LastColumn).Offset(0, -1)
    End If
   '------------------------------------------
 
'2200 прибыль убыток от продаж ------------------------
    If shdfrom.Range("B" & i) = 1520 Then
        KZ = shdfrom.Cells(i, LastColumn)
        KZ0 = shdfrom.Cells(i, LastColumn).Offset(0, -1)
    End If
'------------------------------------------------------
 
'2400 прибыль убыток от продаж ------------------------
    If shdfrom.Range("B" & i) = 2400 Then
        NP = shdfrom.Cells(i, LastColumn)
        NP0 = shdfrom.Cells(i, LastColumn).Offset(0, -1)
    End If
'------------------------------------------------------
 
 
Select Case shdfrom.Range("B" & i)
            Case 1230: DZ = shdfrom.Cells(i, LastColumn)
                       DZ0 = shdfrom.Cells(i, LastColumn).Offset(0, -1)
                GoTo Nexti
            Case 1210: TMC = shdfrom.Cells(i, LastColumn)
                       TMC0 = shdfrom.Cells(i, LastColumn).Offset(0, -1)
                GoTo Nexti
            Case 1170: KFV = shdfrom.Cells(i, LastColumn)
                       KFV0 = shdfrom.Cells(i, LastColumn).Offset(0, -1)
                GoTo Nexti
            Case 1240: KFV = KFV + shdfrom.Cells(i, LastColumn)
                       KFV0 = KFV0 + shdfrom.Cells(i, LastColumn).Offset(0, -1)
                GoTo Nexti
End Select
 
 
Nexti:
Next i
 
If IsEmpty(InterestPayable) Or InterestPayable = 0 Then InterestPayable = 1
'-12 строка -------------------------------
 
If Debt0 > 0 And Debt > 0 Then
        If (Debt / Debt0) > (Sales / Sales0) And (EBIT / InterestPayable) < 1.5 Then
            shdto.Range("E12") = "Динамика долга=" & FormatPercent((Debt / Debt0) - 1, 2) & vbNewLine & _
            "Динамика выручки=" & FormatPercent((Sales / Sales0) - 1, 2) & vbNewLine & _
            "Прибыль от продаж / проценты к уплате=" & FormatNumber(EBIT / InterestPayable, 2)
        Else
            shdto.Range("E12") = ""
            shdto.Range("F12") = "Динамика долга=" & FormatPercent(Debt / Debt0 - 1, 2) & vbNewLine & _
            "Динамика выручки=" & FormatPercent(Sales / Sales0 - 1, 2) & vbNewLine & _
            "Прибыль от продаж / проценты к уплате=" & FormatNumber(EBIT / InterestPayable, 2)
        End If
 
Else
    shdto.Range("E12") = ""
    Debt0 = 1
    shdto.Range("F12") = "Динамика выручки=" & FormatPercent(Sales / Sales0 - 1, 2) & vbNewLine & _
    "Прибыль от продаж / проценты к уплате=" & FormatNumber(EBIT / InterestPayable, 2)
End If
 
'------------------------------------------
 
'-14 строка -------------------------------
            If (KZ / KZ0) > (Sales / Sales0) And Sales > Sales0 Then
                shdto.Range("E14") = "КЗ увеличилась на " & MyFormatMLN(KZ - KZ0) & " (" & FormatPercent((KZ / KZ0) - 1, 2) & ")"
            Else
                shdto.Range("E14") = ""
                shdto.Range("F14") = "КЗ снизилась на " & MyFormatMLN(KZ - KZ0) & " (" & FormatPercent((KZ / KZ0) - 1, 2) & ")"
            End If
'------------------------------------------
 
'-15 строка -------------------------------
            If (Sales / Sales0) < 0.85 Then
                shdto.Range("E15") = "Выручка снизилась на " & MyFormatMLN(Sales - Sales0) & " (" & FormatPercent(Sales / Sales0 - 1, 2) & ")"
            Else
                shdto.Range("E15") = ""
                shdto.Range("F15") = "Выручка увеличилась на " & MyFormatMLN(Sales - Sales0) & " (" & FormatPercent(Sales / Sales0 - 1, 2) & ")"
            End If
'------------------------------------------
 
'-16 строка -------------------------------
            If (NP / NP0) < 0.5 And NP > 0 Then
                shdto.Range("E16") = "ЧП снизилась на " & MyFormatMLN(NP - NP0) & " (" & FormatPercent(NP / NP0 - 1, 2) & ")"
            ElseIf 1 > (NP / NP0) And (NP / NP0) > 0.5 Then
                shdto.Range("E16") = ""
                shdto.Range("F16") = "ЧП снизилась на " & MyFormatMLN(NP - NP0) & " (" & FormatPercent(NP / NP0 - 1, 2) & ")"
            Else
                shdto.Range("E16") = ""
                shdto.Range("F16") = "ЧП увеличилась на " & MyFormatMLN(NP - NP0) & " (" & FormatPercent(NP / NP0 - 1, 2) & ")"
            End If
 
            If NP < 0 Then
                shdto.Range("E16") = "ЧП отрицательная на " & MyFormatMLN(NP) & " ( годом ранее " & MyFormatMLN(NP0) & ")"
                shdto.Range("F16") = "ЧП снизилась на " & MyFormatMLN(NP - NP0) & " (" & FormatPercent(NP / NP0 - 1, 2) & ")"
            End If
'------------------------------------------
 
'-17 строка -------------------------------
 
            If (DZ / DZ0) > 1 And DZ0 <> 0 Then
                DDZ = "ДЗ увеличилась на " & MyFormatMLN(DZ - DZ0) & " (" & FormatPercent(DZ / DZ0 - 1, 2) & ")"
            Else
                DDZ = "ДЗ снизилась на " & MyFormatMLN(DZ - DZ0) & " (" & FormatPercent(DZ / DZ0 - 1, 2) & ")"
            End If
 
            If (TMC / TMC0) > 1 And TMC0 <> 0 Then
                TMC = "ТМЦ увеличились на " & MyFormatMLN(TMC - TMC0) & " (" & FormatPercent(TMC / TMC0 - 1, 2) & ")"
            Else
                TMC = "ТМЦ снизились на " & MyFormatMLN(TMC - TMC0) & " (" & FormatPercent(TMC / TMC0 - 1, 2) & ")"
            End If
 
            If (KFV / KFV0) > 1 And KFV0 <> 0 Then
                KFV = "КФВ увеличились на " & MyFormatMLN(KFV - KFV0) & " (" & FormatPercent(KFV / KFV0 - 1, 2) & ")"
            Else
                KFV = "КФВ снизились на " & MyFormatMLN(KFV - KFV0) & " (" & FormatPercent(KFV / KFV0 - 1, 2) & ")"
            End If
 
            shdto.Range("F17") = DDZ & vbNewLine & TMC & vbNewLine & KFV
 
 
            If NA - NA0 < 0 Then
                shdto.Range("E19") = "Выплачено дивидендов на сумму " & MyFormatMLN(NA0 - NA + NP) & " (" & FormatPercent((NA0 - NA + NP) / NA, 2) & ")"
            Else
                shdto.Range("E19") = ""
                shdto.Range("F19") = "Капитал увеличился на " & MyFormatMLN(NA - NA0) & " ( ЧП=" & MyFormatMLN(NP) & ")"
            End If
 
 
            If NA0 + NP <> NA Then
                shdto.Range("F19") = shdto.Range("F19") & vbNewLine & "Выплачено дивидендов на сумму " & MyFormatMLN(NA0 - NA + NP) & " (" & FormatPercent((NA0 - NA + NP) / NA, 2) & ")"
            End If
'------------------------------------------
 
shdto.Range("E1:F200").WrapText = False
 
 
End Sub