Анализ эффективности вложений денежных средств в РКО

Страница 12

Else

V(k) = V(k) - Cells(i; 6)

End If

cont:

i = i + 1

Wend

For k = 1 To BumNum

For i = dates(k) To 1 Step -1

If V(k) > Volume(k; i) Then

V(k) = V(k) - Volume(k; i)

Else

Volume(k; i) = V(k)

BeginIndex(k) = i

Exit For

End If

Next i

Next k

For k = 1 To BumNum

BumIndex(k) = False

If V(k) > 0 Then BumIndex(k) = True

Next k

ComBirga = Worksheets("Инфо").Cells(1; 2)

i = 2

While Cells(i; 1) <> Empty

If (Cells(i; 1) = CurDate And Cells(i; 2) = DilerConst) _

And (Cells(i; 7) <> "зачисление" And Cells(i; 7) <> "списание") Then

For k = 1 To BumNum

If Cells(i; 3) = Bum(k) Then

BumIndex(k) = True

If Not IsEmpty(Cells(i; 4)) Then

ComMas(k) = ComMas(k) + Format(Cells(i; 4) * Cells(i; 6) * ComBirga * 0,1 + 0,0001; "0,00")

Else

If Cells(i; 5) <> 100 Then

ComMas(k) = ComMas(k) + Format(Cells(i; 5) * Cells(i; 6) * ComBirga * 0,1 + 0,0001; "0,00")

End If

Next k

End If

i = i + 1

Wend

Set Sheet = Worksheets("Сделки")

Worksheets("Журнал лицевого учета").Select

Cells(5; 1) = CurDate

Cells(49; 2) = ComBirga

Покупка = False

Продажа = False

Vol = 0

sum = 0

For k = 1 To BumNum

If BumIndex(k) Then

m = 7

Range("A7:C43").ClearContents

Range("E7:G43").ClearContents

Vol = 0

sum = 0

For i = BeginIndex(k) To dates(k)

If Volume(k; i) > 0 Then

Cells(m; 1) = DateMas(k; i)

Cells(m; 2) = Volume(k; i)

Cells(m; 3) = Format(Price(k; i); "0,00")

Vol = Vol + Volume(k; i)

sum = sum + Format(Price(k; i); "0,00") * Volume(k; i) * 10

m = m + 1

End If

Next i

Cells(6; 2) = Vol

Cells(6; 4) = sum

Cells(49; 3) = ComMas(k)

Cells(5; 3) = CStr(Bum(k)) + "MFTS"

i = 2

m1 = 7

j = BeginIndex(k)

While Sheet.Cells(i; 1) <> Empty

If Sheet.Cells(i; 1) = CurDate And Sheet.Cells(i; 3) = Bum(k) And _

Sheet.Cells(i; 7) <> "зачисление" And Sheet.Cells(i; 7) <> "списание" And _

Sheet.Cells(i; 2) = DilerConst Then

If Not IsEmpty(Sheet.Cells(i; 4)) Then

Покупка = True

Cells(m; 1) = Sheet.Cells(i; 1)

Cells(m; 2) = Sheet.Cells(i; 6)

Cells(m; 3) = Sheet.Cells(i; 4)

Volume(k; dates(k)) = Sheet.Cells(i; 6)

Price(k; dates(k)) = Sheet.Cells(i; 4)

DateMas(k; dates(k)) = Sheet.Cells(i; 4)

dates(k) = dates(k) + 1

m = m + 1

Else

Продажа = True

Vol = Sheet.Cells(i; 6)

If Vol < Volume(k; j) Then

Cells(m1; 5) = Vol

Cells(m1; 6) = Format(Price(k; j); "0,00")

Cells(m1; 7) = Sheet.Cells(i; 5)

Volume(k; j) = Volume(k; j) - Sheet.Cells(i; 6)

m1 = m1 + 1

Else

If Volume(k; j) = 0 Then j = j + 1

While Vol > Volume(k; j) And Volume(k; j) <> Empty

Cells(m1; 5) = Volume(k; j)

Cells(m1; 6) = Format(Price(k; j); "0,00")

Cells(m1; 7) = Sheet.Cells(i; 5)

Vol = Vol - Volume(k; j)

j = j + 1

m1 = m1 + 1

Wend

If Volume(k; j) <> Empty Then

Cells(m1; 5) = Vol

Cells(m1; 6) = Format(Price(k; j); "0,00")

Cells(m1; 7) = Sheet.Cells(i; 5)

Volume(k; j) = Volume(k; j) - Vol

m1 = m1 + 1

End If

i = i + 1

Wend

no_do:

MagMas(k; 1) = Format(Cells(46; 3); "0,00")

MagMas(k; 2) = Format(Cells(47; 3); "0,00")

MagMas(k; 3) = Format(Cells(48; 3); "0,00")

MagMas(k; 4) = Format(Cells(45; 4); "0,00")

If DialogPrint("Журнал лицевого учета"; 1) Then Exit Sub

End If

Next k

' Формирование журнала оборотов

Worksheets("ЖурналОборотов").Select

Cells(6; 1) = CurDate

Range(Cells(7; 1); Cells(100; 6)).Delete shift:=xlToLeft

m = 7

For k = 1 To BumNum

If BumIndex(k) Then

Cells(m; 1) = CStr(Bum(k)) + "MFTS"

Cells(m; 2) = MagMas(k; 1)

Cells(m; 3) = MagMas(k; 2)

Cells(m; 4) = MagMas(k; 3)

Cells(m; 5) = MagMas(k; 4)

Cells(m; 6) = ComMas(k)

Cells(m; 1).Font.Bold = True

Cells(m; 2).NumberFormat = "0,00"

Cells(m; 3).NumberFormat = "0,00"

Cells(m; 4).NumberFormat = "0,00"

Cells(m; 5).NumberFormat = "0,00"

Cells(m; 6).NumberFormat = "0,00"

m = m + 1

End If

Next k

For i = 2 To 6

sum = 0

For m1 = 7 To m - 1

sum = sum + Cells(m1; i)

Next m1

Cells(m; i) = sum

Cells(m; i).NumberFormat = "0,00"

Next i

Mag(1) = Cells(m; 2)

Mag(2) = Cells(m; 3)

Mag(3) = Cells(m; 4)

Mag(4) = Cells(m; 6)

If Cells(m; 2) > 0 Then Cells(m + 1; 2) = "Дт" + S192

If Cells(m; 2) < 0 Then Cells(m + 1; 2) = "Кт" + S192

If Cells(m; 3) > 0 Then Cells(m + 1; 3) = "Дт" + S904

If Cells(m; 3) < 0 Then Cells(m + 1; 3) = "Кт" + S904

If Cells(m; 4) > 0 Then Cells(m + 1; 4) = "Кт" + S960

If Cells(m; 4) < 0 Then Cells(m + 1; 4) = "Дт" + S970

Cells(m + 1; 6) = "Дт" + S970

Range(Cells(m + 1; 2); Cells(m + 2; 6)).HorizontalAlignment = xlCenter

Range(Cells(m + 1; 1); Cells(m + 1; 6)).Interior.ColorIndex = 15

Cells(m + 2; 6) = "Кт" + S904

Cells(m + 2; 6).Interior.ColorIndex = 15

Range(Cells(7; 1); Cells(m - 1; 6)).Borders(xlRight).Weight = xlThin

Range(Cells(m; 1); Cells(m; 6)).Borders(xlRight).LineStyle = xlDouble

Range(Cells(m; 1); Cells(m; 6)).Borders(xlLeft).LineStyle = xlDouble

Range(Cells(m; 1); Cells(m; 6)).Borders(xlTop).LineStyle = xlDouble

Range(Cells(m; 1); Cells(m; 6)).Borders(xlBottom).LineStyle = xlDouble

Cells(m + 2; 4) = "Подпись ответственного"

Cells(m + 3; 4) = "сотрудника"

Range(Cells(m + 2; 4); Cells(m + 3; 4)).Font.Size = 8

Range(Cells(m + 2; 4); Cells(m + 3; 4)).HorizontalAlignment = xlLeft

Range(Cells(7; 1); Cells(m + 4; 6)).BorderAround Weight:=xlMedium

Range(Cells(m + 2; 3); Cells(m + 4; 3)).Borders(xlRight).Weight = xlThin

Range(Cells(m + 1; 1); Cells(m + 1; 5)).Borders(xlBottom).Weight = xlThin

Cells(m + 2; 6).Borders(xlLeft).Weight = xlThin

Cells(m + 2; 6).Borders(xlBottom).Weight = xlThin

If DialogPrint("ЖурналОборотов"; 1) Then Exit Sub

' печать мемориального ордера

Dim StrS As String

With DialogSheets("ДиалогОперация")

.Show

If .OptionButtons(1).Value = xlOn Then StrS = "Покупка"

If .OptionButtons(2).Value = xlOn Then StrS = "Продажа"

If .OptionButtons(3).Value = xlOn Then StrS = "Погашение"

If .OptionButtons(4).Value = xlOn Then StrS = "Покупка / Продажа"

If .OptionButtons(5).Value = xlOn Then StrS = "Покупка / Погашение"

End With

Worksheets("Ордер").Select

i = CInt(InputBox("Введите номер 1-го ордера"))

If Mag(1) > 0 Then

If Mag(2) < 0 Then

If MemoOrder(i; min(Mag(1); Mag(2)); S192; S904; 0; _

StrS + " РКО за " + CStr(CurDate)) Then Exit Sub

i = i + 1

End If

If Mag(3) > 0 Then

If MemoOrder(i; min(Mag(1); Mag(3)); S192; S960; 0; _

"Доход от продажи РКО за " + CStr(CurDate)) Then Exit Sub

i = i + 1

End If

If Mag(2) > 0 Then

If Mag(1) < 0 Then

If MemoOrder(i; min(Mag(2); Mag(1)); S904; S192; 0; _

StrS + " РКО за " + CStr(CurDate)) Then Exit Sub

i = i + 1

End If

If Mag(3) > 0 Then

If MemoOrder(i; min(Mag(2); Mag(3)); S904; S960; 0; _

"Доход от продажи РКО за " + CStr(CurDate)) Then Exit Sub