Attribute VB_Name = "Count_A"
Sub TP_Count()
Const k As Single = 1#
Dim t1 As Object, t2 As Object, t3 As Object, t4 As Object, t5 As Object, _
t6 As Object, t7 As Object, t8 As Object, t9 As Object, _
t10 As Object, t11 As Object, t12 As Object, t13 As Object, t14 As Object, t15 As Object, t16 As Object, t17 As Object
With ActiveDocument
Set t1 = .Tables(2) 'Таблиця 1.1 Техніко-економічні показники
Set t2 = .Tables(3) 'Таблиця 1.2 Аналіз структури собівартості одиниці продукції, %
Set t3 = .Tables(4) 'Таблиця 1.3 Приведення показників до порівнянних одиниць вимірювання
Set t4 = .Tables(5) 'Таблиця 1.4 Техніко-економічні показники, приведені до порівнянних одиниць вимірювання
Set t5 = .Tables(6) 'Таблиця 1.5 Динаміка техніко-економічних показників, %
Set t6 = .Tables(7) 'Таблиця 2.1 Загальні відомості про випуск продукції за грудень 1999 р.
Set t7 = .Tables(8) 'Таблиця 2.2 Відомості про обсяги і трудомісткість випущеної продукції
Set t8 = .Tables(9) 'Таблиця 2.3 Дані про забезпеченість підприємства матеріалами за грудень 1999 р.
Set t9 = .Tables(10) 'Таблиця 2.4 Відомості про забезпеченість підприємства робітниками за грудень 1999 р
'Таблиця 2.5 Результати аналізу випуску продукції за грудень 1999 р.
'Таблиця 2.6 Заходи щодо збільшення обсягу випуску продукції
Set t10 = .Tables(13) 'Таблиця 2.7 Відомості про ритмічність роботи підприємства за грудень 1999 р.
Set t11 = .Tables(14) 'Таблиця 2.8 Дані про реалізацію продукції
Set t12 = .Tables(15) 'Таблиця 2.9 Зіставлення показників реалізації продукції з планом і попереднім періодом
Set t13 = .Tables(16) 'Таблиця 3.1 Відомості про основні засоби підприємства
Set t14 = .Tables(17) 'Таблиця 3.2 Відомості про структуру техніки, що застосовується на підприємстві
Set t15 = .Tables(18) 'Таблиця 3.3 Відомості про терміни служби техніки та непродуктивне збільшення основних фондів
Set t16 = .Tables(19) 'Таблиця 3.4 Дані для розрахунку економічного збитку від непродуктивного збільшення основних засобів
Set t17 = .Tables(20) 'Таблиця 3.5 Відомості для розрахунку фондовіддачі
'Таблиця 3.6 Результати аналізу фондовіддачі за грудень 1999 р.
'Таблиця 3.7 Заходи щодо збільшення ефективності використання основних фондів
End With
Dim i As Byte, j As Byte, _
c As Currency, d As Currency, n As Currency, v As Currency
For j = 4 To 8
For i = 5 To 27
Select Case i
Case 8: t1.Cell(i, j) = CCur(rs(t1.Cell(6, j)) / rs(t1.Cell(5, j)))
Case 9: If j > 5 Then t1.Cell(i, j) = CCur(rs(t1.Cell(8, j)) / rs(t1.Cell(8, j - 1)))
Case 10: 'Nothing
Case 14: t1.Cell(i, j) = CCur(rs(t1.Cell(5, j)) / rs(t1.Cell(11, j)) / 12)
Case 15: t1.Cell(i, j) = CCur(rs(t1.Cell(5, j)) / rs(t1.Cell(12, j)) / 12)
Case 16: t1.Cell(i, j) = CCur(rs(t1.Cell(12, j)) / rs(t1.Cell(13, j)))
Case 18: t1.Cell(i, j) = CCur(rs(t1.Cell(17, j)) / rs(t1.Cell(5, j)))
Case 23: t1.Cell(i, j) = rs(t1.Cell(18, j)) - rs(t1.Cell(19, j)) - rs(t1.Cell(20, j)) - rs(t1.Cell(21, j)) - rs(t1.Cell(22, j))
Case Else: 'Reserved for Error Case
End Select
Next
t1.Cell(28, j) = rs(t1.Cell(26, j)) - rs(t1.Cell(27, j))
t1.Cell(29, j) = rs(t1.Cell(7, j)) - rs(t1.Cell(17, j))
Next
t1.Cell(9, 5) = CCur(rs(t1.Cell(8, 5)) / rs(t1.Cell(8, 4)) * 100)
For j = 3 To 7: For i = 0 To 3
t2.Cell(5 + i, j) = CCur(rs(t1.Cell(19 + i, j + 1)) / rs(t1.Cell(18, j + 1))) * 100
Next
t2.Cell(9, j) = 100 - rs(t2.Cell(5, j)) - rs(t2.Cell(6, j)) - rs(t2.Cell(7, j)) - rs(t2.Cell(8, j))
Next
For j = 3 To 7: t3.Cell(4, j) = CCur(rs(t1.Cell(17, j + 1)) / rs(t1.Cell(6, j + 1))): Next
t3.Cell(6, 7) = cs(t1.Cell(17, 8))
For j = 3 To 6
t3.Cell(5, j) = CCur(rs(t3.Cell(4, j)) / rs(t3.Cell(4, 7)))
t3.Cell(6, j) = rc(rs(t3.Cell(5, j)) * rs(t1.Cell(17, 8)))
t3.Cell(7, j) = CCur(rs(t3.Cell(6, j)) / rs(t1.Cell(17, j + 1)))
Next
For i = 4 To 6
t4.Cell(i, 8) = cs(t1.Cell(i + 1, 8))
Next
For j = 4 To 7
t4.Cell(4, j) = cs(t1.Cell(5, j))
t4.Cell(5, j) = rc(rs(t1.Cell(6, j)) * rs(t3.Cell(7, j - 1)))
t4.Cell(6, j) = rc(rs(t1.Cell(7, j)) * rs(t3.Cell(7, j - 1)))
Next
For i = 10 To 28
t4.Cell(i - 3, 8) = cs(t1.Cell(i + 1, 8))
For j = 4 To 7
Select Case i
Case 10 To 15: t4.Cell(i - 3, j) = cs(t1.Cell(i + 1, j))
Case 16: t4.Cell(i - 3, j) = cs(t3.Cell(6, j - 1))
Case 17 To 21: t4.Cell(i - 3, j) = CCur(rs(t1.Cell(i + 1, j)) * rs(t3.Cell(7, j - 1)))
Case 22: t4.Cell(i - 3, j) = rs(t4.Cell(14, j)) - rs(t4.Cell(15, j)) - rs(t4.Cell(16, j)) - rs(t4.Cell(17, j)) - rs(t4.Cell(18, j))
Case 27: t4.Cell(i - 3, j) = rs(t4.Cell(22, j)) - rs(t4.Cell(23, j))
Case 28: t4.Cell(i - 3, j) = rs(t4.Cell(6, j)) - rs(t4.Cell(13, j))
Case Else: t4.Cell(i - 3, j) = rc(rs(t1.Cell(i + 1, j)) * rs(t3.Cell(7, j - 1)))
End Select
Next:Next
For j = 4 To 7
For i = 4 To 25
t5.Cell(i, j) = CStr(CCur(rs(t4.Cell(i, j + 1)) / rs(t4.Cell(i, 4))) * 100) + "%"
Next:Next
t6.Cell(5, 4) = rs(t1.Cell(8, 7)) * 1000
t6.Cell(5, 7) = rs(t1.Cell(8, 8)) * 1000
t6.Cell(4, 6) = rc(rs(t6.Cell(3, 4)) * rs(t6.Cell(5, 4)) / 1000, 0)
t6.Cell(5, 6) = cs(t6.Cell(5, 4))
t6.Cell(5, 5) = CCur(rs(t6.Cell(4, 5)) / rs(t6.Cell(3, 5))) * 1000
For i = 3 To 5
t6.Cell(i, 8) = rs(t6.Cell(i, 7)) - rs(t6.Cell(i, 4))
t6.Cell(i, 9) = CStr(CCur(rs(t6.Cell(i, 7)) / rs(t6.Cell(i, 4))) * 100) + "%"
t6.Cell(i, 10) = rs(t6.Cell(i, 7)) - rs(t6.Cell(i, 5))
t6.Cell(i, 11) = CStr(CCur(rs(t6.Cell(i, 7)) / rs(t6.Cell(i, 5))) * 100) + "%"
Next
For i = 4 To 7
t7.Cell(i, 5) = rs(t7.Cell(i, 4)) - rs(t7.Cell(i, 3))
t7.Cell(i, 7) = rc(rs(t7.Cell(i, 4)) / rs(t7.Cell(i, 6)), 0)
t7.Cell(i, 8) = rs(t7.Cell(i, 11)) * rs(t7.Cell(i, 10))
t7.Cell(i, 9) = rs(t7.Cell(i, 7)) - rs(t7.Cell(i, 8))
Next
t7.Cell(8, 5) = rs(t7.Cell(8, 4)) - rs(t7.Cell(8, 3))
Call SumColumn(t7, 7, 4)
Call SumColumn(t7, 8, 4)
Call SumColumn(t7, 9, 4)
Call SumColumn(t7, 11, 4)
For i = 3 To 5
t8.Cell(i, 6) = CCur(rs(t8.Cell(i, 4)) / rs(t8.Cell(i, 5)))
t8.Cell(i, 7) = 1 - rs(t8.Cell(i, 6))
Next
For i = 4 To 8
t9.Cell(i, 3) = cs(t7.Cell(i, 7))
t9.Cell(i, 5) = cs(t7.Cell(i, 8))
t9.Cell(i, 7) = cs(t7.Cell(i, 11))
Next
For i = 4 To 7
t9.Cell(i, 4) = rc(rs(t7.Cell(i, 3)) / rs(t7.Cell(i, 6)), 0)
t9.Cell(i, 10) = rc(rs(t9.Cell(i, 7)) * rs(t9.Cell(i, 12)), 0)
t9.Cell(i, 8) = rc(rs(t9.Cell(i, 11)) / rs(t9.Cell(i, 13)), 0)
t9.Cell(i, 6) = rs(t9.Cell(i, 8)) * rs(t7.Cell(i, 10))
t9.Cell(i, 9) = rs(t9.Cell(i, 7)) - rs(t9.Cell(i, 8))
Next
Call SumColumn(t9, 4, 4)
Call SumColumn(t9, 10, 4)
Call SumColumn(t9, 11, 4)
Call SumColumn(t9, 6, 4)
Call SumColumn(t9, 8, 4)
Call SumColumn(t9, 9, 4)
t10.Cell(34, 2) = cs(t7.Cell(4, 4)): t10.Cell(34, 3) = cs(t7.Cell(5, 4))
t10.Cell(34, 4) = cs(t7.Cell(6, 4)): t10.Cell(34, 5) = cs(t7.Cell(7, 4))
t10.Cell(34, 6) = cs(t7.Cell(8, 4))
For i = 3 To 32
Call SumRow(t10, i, , 5):Next
For i = 2 To 5
t10.Cell(33, i) = rs(t10.Cell(34, i)) - SumColumn(t10, i, , 32, False)
t10.Cell(36, i) = MaxColumn(t10, i, , 33, False)
t10.Cell(37, i) = rs(t10.Cell(36, i)) - rs(t10.Cell(35, i))
t10.Cell(38, i) = rs(t10.Cell(37, i)) * 31
Next
Call SumRow(t10, 36, , 5): Call SumRow(t10, 33, , 5)
Call SumRow(t10, 37, , 5): Call SumRow(t10, 38, , 5)
For i = 4 To 5
t11.Cell(4, i) = cs(t1.Cell(5, i + 3))
t11.Cell(5, i) = cs(t1.Cell(6, i + 3))
t11.Cell(7, i) = cs(t1.Cell(7, i + 3))
Next
For i = 4 To 6
t11.Cell(6, i) = CCur(rs(t11.Cell(5, i)) / rs(t11.Cell(4, i)))
t11.Cell(8, i) = rc(rs(t11.Cell(7, i)) / rs(t11.Cell(6, i)), 0)
t11.Cell(9, i) = rc(rs(t11.Cell(10, i)) / rs(t11.Cell(6, i)), 0)
t11.Cell(15, i) = rc(rs(t11.Cell(13, i)) * rs(t11.Cell(6, i)))
t11.Cell(16, i) = rs(t11.Cell(15, i)) - rs(t11.Cell(14, i))
t11.Cell(18, i) = rc(rs(t11.Cell(17, i)) * rs(t11.Cell(6, i)))
Next
For i = 3 To 17
t12.Cell(i, 4) = CStr(CCur(rs(t11.Cell(i + 1, 5)) / rs(t11.Cell(i + 1, 6))) * 100) + "%"
t12.Cell(i, 5) = rs(t11.Cell(i + 1, 5)) - rs(t11.Cell(i + 1, 4))
t12.Cell(i, 6) = CStr(CCur(rs(t11.Cell(i + 1, 5)) / rs(t11.Cell(i + 1, 4))) * 100) + "%"
Next
t13.Cell(17, 3) = cs(t4.Cell(20, 7))
t13.Cell(15, 3) = cs(t4.Cell(21, 7))
t13.Cell(16, 3) = rs(t13.Cell(17, 3)) - rs(t13.Cell(15, 3))
t13.Cell(17, 7) = cs(t4.Cell(20, 8))
t13.Cell(15, 7) = cs(t4.Cell(21, 8))
t13.Cell(16, 7) = rs(t13.Cell(17, 7)) - rs(t13.Cell(15, 7))
For i = 3 To 8
c = rs(t13.Cell(15, i))
t13.Cell(11, i) = rs(t13.Cell(15, i)) - rs(t13.Cell(10, i)) - rs(t13.Cell(9, i)) - rs(t13.Cell(8, i)) - rs(t13.Cell(7, i)) - rs(t13.Cell(6, i))
c = rs(t13.Cell(16, i))
t13.Cell(14, i) = rs(t13.Cell(16, i)) - rs(t13.Cell(4, i)) - rs(t13.Cell(5, i)) - rs(t13.Cell(12, i)) - rs(t13.Cell(13, i))
i = i + 4 'Increasing step
Next
For i = 4 To 14
t13.Cell(i, 7) = rs(t13.Cell(i, 3)) + rs(t13.Cell(i, 4)) - rs(t13.Cell(i, 6))
t13.Cell(i, 10) = rs(t13.Cell(i, 7)) - rs(t13.Cell(i, 9))
Next
t13.Cell(15, 9) = rs(t13.Cell(11, 9)) + rs(t13.Cell(10, 9)) + rs(t13.Cell(9, 9)) + rs(t13.Cell(8, 9)) + rs(t13.Cell(7, 9)) + rs(t13.Cell(6, 9))
t13.Cell(16, 9) = rs(t13.Cell(14, 9)) + rs(t13.Cell(4, 9)) + rs(t13.Cell(5, 9)) + rs(t13.Cell(12, 9)) + rs(t13.Cell(13, 9))
t13.Cell(17, 9) = rs(t13.Cell(15, 9)) + rs(t13.Cell(16, 9))
For i = 15 To 17
t13.Cell(i, 6) = rs(t13.Cell(i, 3)) + rs(t13.Cell(i, 4)) - rs(t13.Cell(i, 7))
t13.Cell(i, 10) = rs(t13.Cell(i, 7)) - rs(t13.Cell(i, 9))
Next
t14.Cell(4, 5) = rc(SumColumn(t14, 11, 5, 15, False) / 11, 4): t14.Cell(16, 5) = rc(SumColumn(t14, 11, 17, 36, False) / 20, 4)
t14.Cell(4, 6) = rs(t14.Cell(4, 4)) - rs(t14.Cell(4, 5)): t14.Cell(16, 6) = rs(t14.Cell(16, 4)) - rs(t14.Cell(16, 5))
For i = 5 To 36
If i <> 16 Then
t14.Cell(i, 11) = CCur(rs(t14.Cell(i, 6)) / rs(t14.Cell(i, 3)))
t14.Cell(i, 12) = rs(t14.Cell(i, 10)) - rs(t14.Cell(i, 11))
t14.Cell(i, 13) = CCur(rs(t14.Cell(i, 5)) / rs(t14.Cell(i, 3)))
t15.Cell(i, 6) = cs(t14.Cell(i, 12))
t15.Cell(i, 8) = cs(t14.Cell(i, 3))
t15.Cell(i, 5) = rs(t15.Cell(i, 3)) - rs(t15.Cell(i, 4))
t15.Cell(i, 7) = rc(rs(t15.Cell(i, 5)) * rs(t15.Cell(i, 6)))
t15.Cell(i, 11) = CCur(rs(t15.Cell(i, 10)) / rs(t15.Cell(i, 9)))
End If
Next
t14.Cell(4, 7) = rc(SumColumn(t14, 13, 5, 15, False) / 11, 4): t14.Cell(16, 7) = rc(SumColumn(t14, 13, 17, 36, False) / 20, 4)
For i = 4 To 36: t15.Cell(i, 12) = CCur(rs(t15.Cell(i, 4)) / rs(t15.Cell(i, 3)))
Next: t15.Cell(37, 10) = CCur(rs(t15.Cell(37, 4)) / rs(t15.Cell(37, 3)))
For i = 3 To 5
t15.Cell(4, i) = SumColumn(t15, i, 5, 15, False): t15.Cell(16, i) = SumColumn(t15, i, 17, 36, False)
Next
t15.Cell(4, 7) = SumColumn(t15, 7, 5, 15, False): t15.Cell(16, 7) = SumColumn(t15, 7, 17, 36, False)
t15.Cell(4, 11) = CCur(SumColumn(t15, 11, 5, 15, False) / 11): t15.Cell(16, 11) = CCur(SumColumn(t15, 11, 17, 36, False) / 20)
t15.Cell(37, 7) = rs(t15.Cell(4, 7)) + rs(t15.Cell(16, 7))
t15.Cell(37, 9) = CCur((rs(t15.Cell(4, 11)) + rs(t15.Cell(16, 11))) / 2)
t15.Cell(37, 3) = cs(t13.Cell(15, 7)): t15.Cell(37, 4) = cs(t13.Cell(15, 9))
t15.Cell(37, 5) = cs(t13.Cell(15, 10))
For i = 3 To 5
t17.Cell(i, 4) = cs(t6.Cell(i, 4)): t17.Cell(i, 5) = cs(t6.Cell(i, 7))
t17.Cell(i, 6) = cs(t6.Cell(i, 8)): t17.Cell(i, 7) = cs(t6.Cell(i, 9))
Next
t17.Cell(8, 4) = cs(t16.Cell(5, 4)): t17.Cell(8, 5) = cs(t16.Cell(5, 4))
For i = 6 To 10
t17.Cell(i, 6) = rs(t17.Cell(i, 5)) - rs(t17.Cell(i, 4))
t17.Cell(i, 7) = CStr(rc(rs(t17.Cell(i, 5)) * 100 / rs(t17.Cell(i, 4)))) + "%"
Next
End Sub
Private Function replace(s As String, s1 As String, Optional s2 As String = ".") As String
Dim p As Integer
p = InStr(s, s1)
If p > 0 Then replace = Left(s, p - 1) + s2 + Mid(s, p + Len(s1)) Else replace = s
End Function
Private Function rs(s As String) As Currency
rs = Val(replace(s, ","))
End Function
Private Function cs(s As String)
cs = Left(s, Len(s) - 2)
End Function
Private Function rc(c As Currency, Optional n As Byte = 2)
n = 4 - n
rc = CCur(c / (10 ^ n)) * (10 ^ n)
End Function
Private Function SumColumn(t As Object, ByVal c As Integer, Optional p As Integer = 3, Optional n As Integer = 0, Optional b As Boolean = True) As Currency
If n = 0 Then n = t.Rows.Count - 1
Dim i As Integer
SumColumn = rs(t.Cell(p, c))
For i = p + 1 To n
SumColumn = SumColumn + rs(t.Cell(i, c))
Next
If b Then t.Cell(n + 1, c) = SumColumn
End Function
Private Function SumRow(t As Object, ByVal r As Integer, Optional p As Integer = 2, Optional n As Integer = 0, Optional b As Boolean = True) As Currency
If n = 0 Then n = t.Columns.Count - 1
Dim i As Integer
SumRow = rs(t.Cell(r, p))
For i = p + 1 To n
SumRow = SumRow + rs(t.Cell(r, i))
Next
If b Then t.Cell(r, n + 1) = SumRow
End Function
Private Function MaxColumn(t As Object, ByVal c As Integer, Optional p As Integer = 3, Optional n As Integer = 0, Optional b As Boolean = True) As Currency
If n = 0 Then n = t.Rows.Count - 1
Dim i As Integer, v As Currency
MaxColumn = rs(t.Cell(p, c))
For i = p + 1 To n
v = rs(t.Cell(i, c))
If MaxColumn < v Then MaxColumn = v
Next
If b Then t.Cell(n + 1, c) = MaxColumn
End Function
Sub WhereCell()
MsgBox CStr(Selection.Information(wdEndOfRangeRowNumber)) + ", " + CStr(Selection.Information(wdEndOfRangeColumnNumber))
End Sub
Sub Calc()
InputBox "Result", , Selection.Calculate
End Sub
 |
Донецький державний технічний університет
(назва віщого навчального закладу)
Кафедра Бухгалтерського обліку та Аудиту
Дисципліна Аналіз господарської діяльності
Спеціальність Облік та аудит
Курс 5 Група УА 96 в Семестр 9
ЗАВДАННЯ
на курсовий проект (роботу) студента
| |
Бондаренко Сергій Юрійович
(прізвище, ім'я, по батькові)
1. Тема проекту (роботи) Аналіз основних фондів в умовах товариства з обмеженою відповідальності "Шахта ім. О. О.Скочинського"
2. Строк здачі студентом закінченого проекту (роботи) 20.11.2000
3. Вихідні дані до проекту (роботи) Дані статистичної звітності, що містять відомості про техніко-економічні показники шахти ім. О. О. Скочинського за 1999, 2000 роки; дані аналітичних і синтетичних регістрів обліку основних фондів
4. Зміст розрахунково-пояснювальної записки (перелік питань, які підлягають розробці)
1. Характеристика підприємства
2. Аналіз техніко-економічних показників
3. Аналіз виробництва і реалізації продукції
4. Аналіз стану і використання основних фондів
5. Перелік графічного матеріалу (з точним зазначенням обов'язкових креслень)
Дата видачі завдання 06.09.2000
 |
КАЛЕНДАРНИЙ ПЛАН
| № п/п | Назва етапів курсового проекту (роботи) | Строк виконання етапів проекту (роботи) | Примітки |
| 1. | Аналіз випуску продукції і її реалізації | 22.09 – 30.09 | |
| 2. | Загальна оцінка зміни показників, що | ||
| характеризують стану і використання | |||
| основних фондів підприємства | 01.10 – 20.10 | ||
| 3. | Визначення конкретних причин, що | ||
| спричинили погіршення стану і зниження | |||
| ефективності використання основних | |||
| фондів. Розробка заходів щодо усунення | |||
| негативного впливу виявлених причин | 21.10 – 10.11 | ||
| 4. | Складання пояснювальної записки, | ||
| підготовка до захисту курсової роботи | 11.11 – 20.11 | ||
Студент
(підпис)
Керівник Гавриленко Валентин Андрійович
(підпис) (прізвище, ім'я, по батькові)
« 10 » жовтня 2000 р.
[1] Продуктивність праці розрахована в середньому за місяць
1 Гавріленко В. А. "Теорія і методика економічного аналізу виробниче-господарської діяльності виробничих підприємств" - Донецьк 1998 рік.
Дата: 2019-07-30, просмотров: 217.
