39269 (661078), страница 7
Текст из файла (страница 7)
BumPrice(k) = Sheet.Cells(i; 6)
Else
BumPrice(k) = 0
End If
End If
Next k
End If
i = i + 1
Wend
If Flag Then
MsgBox "Биржевой информации нет. Портфель сформировать невозможно."
Exit Sub
End If
Worksheets("Портфель1").Select
Cells(4; 3) = CurDate
Range("A7:H200").Delete shift:=xlToLeft
m = 7
PortfelCost = 0
PortfelBalance = 0
For k = 1 To BumNum
If Volume(k; BeginIndex(k)) > 0 Then
For i = BeginIndex(k) To dates(k)
If Volume(k; i) > 0 Then
Cells(m; 1) = Bum(k)
Cells(m; 1).NumberFormat = "0"
Cells(m; 2) = DateMas(k; i)
Cells(m; 2).NumberFormat = "ДД.ММ.ГГ"
Cells(m; 3) = Price(k; i)
Cells(m; 3).NumberFormat = "0,00"
Cells(m; 4) = Volume(k; i)
Cells(m; 4).NumberFormat = "0"
DohPog(k; i) = (100 / Price(k; i) - 1) * 36500 / (DatePog(k) - DateMas(k; i))
Cells(m; 5) = DohPog(k; i)
Cells(m; 5).NumberFormat = "0,00"
Cells(m; 8).NumberFormat = "0"
Dim tmp As Long
tmp = CurDate - DateMas(k; i)
Cells(m; 8) = tmp
PortfelBalance = PortfelBalance + Price(k; i) * Volume(k; i)
If BumPrice(k) > 0 Then
PortfelCost = PortfelCost + BumPrice(k) * Volume(k; i)
Else
PortfelCost = PortfelCost + Price(k; i) * Volume(k; i)
End If
If BumPrice(k) > 0 Then
Cells(m; 6) = BumPrice(k)
Cells(m; 6).NumberFormat = "0,00"
If CurDate <> DateMas(k; i) Then
DohPriobr(k; i) = (BumPrice(k) / Price(k; i) - 1) * 36500 / (CurDate - DateMas(k; i))
Cells(m; 7) = DohPriobr(k; i)
Cells(m; 7).NumberFormat = "0,00"
End If
End If
m = m + 1
End If
Next i
Range(Cells(m; 1); Cells(m; 8)).Interior.ColorIndex = 15
m = m + 1
End If
Next k
Range(Cells(7; 1); Cells(m - 1; 8)).Borders(xlLeft).Weight = xlThin
Range(Cells(7; 1); Cells(m - 1; 8)).Borders(xlRight).Weight = xlThin
Range(Cells(7; 1); Cells(m - 1; 8)).Borders(xlTop).Weight = xlThin
Range(Cells(7; 1); Cells(m - 1; 8)).Borders(xlBottom).Weight = xlThin
Range(Cells(7; 1); Cells(m - 1; 8)).BorderAround Weight:=xlMedium
If DialogPrint("Портфель1"; 1) Then Exit Sub
Worksheets("Портфель2").Select
Cells(4; 3) = CurDate
SumPog11 = 0
SumPog22 = 0
SumPriobr11 = 0
SumPriobr22 = 0
AllVol = 0
m = 7
Range("A7:H200").Delete shift:=xlToLeft
For k = 1 To BumNum
If Volume(k; BeginIndex(k)) > 0 Then
SumPog1(k) = 0
SumPog2(k) = 0
SumPriobr1(k) = 0
SumPriobr2(k) = 0
BumVol(k) = 0
For i = BeginIndex(k) To dates(k)
If Volume(k; i) > 0 Then
SumPog1(k) = SumPog1(k) + DohPog(k; i) * Volume(k; i) * (DatePog(k) - DateMas(k; i))
SumPog2(k) = SumPog2(k) + Volume(k; i) * (DatePog(k) - DateMas(k; i))
If CurDate <> DateMas(k; i) Then
SumPriobr1(k) = SumPriobr1(k) + DohPriobr(k; i) * Volume(k; i) * (CurDate - DateMas(k; i))
SumPriobr2(k) = SumPriobr2(k) + Volume(k; i) * (CurDate - DateMas(k; i))
End If
SumPog11 = SumPog11 + SumPog1(k)
SumPog22 = SumPog22 + SumPog2(k)
SumPriobr11 = SumPriobr11 + SumPriobr1(k)
SumPriobr22 = SumPriobr22 + SumPriobr2(k)
BumVol(k) = BumVol(k) + Volume(k; i)
AllVol = AllVol + Volume(k; i)
End If
Next i
Cells(m; 1) = Bum(k)
Cells(m; 1).NumberFormat = "0"
Cells(m; 2) = BumVol(k)
Cells(m; 2).NumberFormat = "0"
Cells(m; 3) = SumPog1(k) / SumPog2(k)
Cells(m; 3).NumberFormat = "0,00"
If SumPriobr2(k) > 0 And SumPriobr1(k) > 0 Then
Cells(m; 4) = SumPriobr1(k) / SumPriobr2(k)
Cells(m; 4).NumberFormat = "0,00"
End If
m = m + 1
End If
Next k
Cells(m; 1) = "Итого"
Cells(m; 1).Font.Bold = True
Cells(m; 1).HorizontalAlignment = xlCenter
Cells(m; 2) = AllVol
Cells(m; 2).NumberFormat = "0"
Cells(m; 3) = SumPog11 / SumPog22
Cells(m; 3).NumberFormat = "0,00"
Cells(m; 4) = SumPriobr11 / SumPriobr22
Cells(m; 4).NumberFormat = "0,00"
Range(Cells(m; 1); Cells(m; 4)).Interior.ColorIndex = 15
Range(Cells(7; 1); Cells(m; 4)).Borders(xlLeft).Weight = xlThin
Range(Cells(7; 1); Cells(m; 4)).Borders(xlRight).Weight = xlThin
Range(Cells(7; 1); Cells(m; 4)).Borders(xlTop).Weight = xlThin
Range(Cells(7; 1); Cells(m; 4)).Borders(xlBottom).Weight = xlThin
Range(Cells(7; 1); Cells(m; 4)).BorderAround Weight:=xlMedium
Range(Cells(m; 1); Cells(m; 4)).BorderAround Weight:=xlMedium
Cells(m + 1; 1) = "Стоимость портфеля по балансу"
Cells(m + 2; 1) = "Текущая стоимость потфеля"
Cells(m + 1; 1).Font.Bold = True
Cells(m + 2; 1).Font.Bold = True
Range(Cells(m + 1; 1); Cells(m + 2; 4)).BorderAround Weight:=xlMedium
Cells(m + 1; 4) = PortfelBalance * 10
Cells(m + 1; 4).NumberFormat = "### ### ###,00"
Cells(m + 1; 4).Font.Bold = True
Cells(m + 2; 4) = PortfelCost * 10
Cells(m + 2; 4).NumberFormat = "### ### ###,00"
Cells(m + 2; 4).Font.Bold = True
If DialogPrint("Портфель2"; 1) Then Exit Sub
End Sub
'-------------------------------- Печать Журнала лицевого учета ---------
Sub PrintMagazine()
Dim Sheet As Object
Dim i; k; BumNum; m; m1; j As Long
Dim Bum(ConstMaxBum) As Long
Dim Volume(); BiginIndex(); dates(); V(); Vol As Integer
Dim sum; Price() As Double
Dim DateMas() As Date
Dim Flag; BumIndex() As Boolean
Dim ComBirga; ComMas(); MagMas(); Mag(4) As Double
CurDate = Worksheets("Врем").Cells(1; 4)
i = 2
Flag = True
Do While Worksheets("Сделки").Cells(i; 1) <> Empty
If Worksheets("Сделки").Cells(i; 1) = CurDate And _
Worksheets("Сделки").Cells(i; 2) = DilerConst Then
Flag = False
Exit Do
End If
i = i + 1
Loop
If Flag Then
MsgBox "Сделок в текущий день не было"
Exit Sub
End If
Set Sheet = Worksheets("Бумаги")
i = 2
BumNum = 0
While Sheet.Cells(i; 1) <> Empty
If (Sheet.Cells(i; 2) = CurDate) Then
Bum(BumNum + 1) = Sheet.Cells(i; 1)
BumNum = BumNum + 1
End If
i = i + 1
Wend
Worksheets("Сделки").Select
Range("B2").Sort Key1:=Range("A2"); Order1:=xlAscending; _
Key2:=Range("D2"); Order2:=xlAscending; _
Header:=xlYes; OrderCustom:=1; _
MatchCase:=False; Orientation:=xlTopToBottom
ReDim Volume(BumNum; MaxCount)
ReDim Price(BumNum; MaxCount)
ReDim DateMas(BumNum; MaxCount)
ReDim dates(BumNum); V(BumNum); BeginIndex(BumNum)
ReDim BumIndex(BumNum); ComMas(BumNum)
ReDim MagMas(BumNum; 4)
For i = 1 To BumNum
ComMas(i) = 0
dates(i) = 1
Next i
i = 2
While Cells(i; 1) <> Empty And CurDate > Cells(i; 1)
If Cells(i; 2) = DilerConst And Cells(i; 7) <> "списание" _
And Cells(i; 7) <> "зачисление" Then
Flag = True
For k = 1 To BumNum ' поиск номера бумаги
If Cells(i; 3) = Bum(k) Then
Flag = False
Exit For
End If
Next k
If Flag Then GoTo cont
If Not IsEmpty(Cells(i; 4)) Then
Volume(k; dates(k)) = Cells(i; 6)
Price(k; dates(k)) = Cells(i; 4)
DateMas(k; dates(k)) = Cells(i; 1)
dates(k) = dates(k) + 1
V(k) = V(k) + Cells(i; 6)
Else
V(k) = V(k) - Cells(i; 6)
End If
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
End If
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
End If
End If
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) = "сотрудника"
![](https://s.studizba.com/z.php?f=/templates/si/i/noavatar.png&w=100&h=100&t=1"){kind=avatar}
