Dim mas(3) As Double

Set Sheet = Worksheets("Биржа")

CurDate = Worksheets("Врем").Cells(1; 4)

Sheets("Биржевая Информация").Select

Cells(3; 10) = CurDate

For i = 1 To 3

mas(i) = 0

Next i

i = 2

n = 7

Range(Cells(n; 1); Cells(n + 100; 17)).Delete shift:=xlToLeft

Flag = True

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

If Sheet.Cells(i; 1) = CurDate Then

Flag = False

Cells(n; 1) = Sheet.Cells(i; 2)

Cells(n; 7) = Sheet.Cells(i; 3)

Cells(n; 9) = Sheet.Cells(i; 4)

Cells(n; 10) = Sheet.Cells(i; 5)

Cells(n; 5).Font.Bold = True

Cells(n; 11) = Sheet.Cells(i; 6)

Cells(n; 11).Font.Bold = True

Cells(n; 12) = Sheet.Cells(i; 7)

Cells(n; 13) = Sheet.Cells(i; 8)

k = 2

While Worksheets("Бумаги").Cells(k; 1) <> Empty

If Worksheets("Бумаги").Cells(k; 1) = Cells(n; 1) Then

Cells(n; 2) = Worksheets("Бумаги").Cells(k; 2)

Cells(n; 3) = Worksheets("Бумаги").Cells(k; 3)

Cells(n; 6) = Worksheets("Бумаги").Cells(k; 4)

End If

k = k + 1

Wend

Cells(n; 2).NumberFormat = "ДД.ММ.ГГ"

Cells(n; 3).NumberFormat = "ДД.ММ.ГГ"

Cells(n; 6).NumberFormat = "# ##0"

Cells(n; 9).NumberFormat = "# ##0"

Range(Cells(n; 10); Cells(n; 17)).NumberFormat = "0,00"

Cells(n; 4) = Cells(3; 10) - Cells(n; 2)

Cells(n; 5) = Cells(n; 3) - Cells(3; 10)

Cells(n; 8) = Cells(n; 9) / Cells(n; 6) * 100

Cells(n; 8).NumberFormat = "0,00"

If Cells(n; 7) <> 0 And Cells(n; 5) <> 0 Then

Cells(n; 14) = (100 / Cells(n; 10) - 1) * 36500 / Cells(n; 5) * 0,85

Cells(n; 15) = (100 / Cells(n; 10) - 1) * 36500 / Cells(n; 5)

Cells(n; 16) = (100 / Cells(n; 11) - 1) * 36500 / Cells(n; 5) * 0,85

Cells(n; 16).Font.Bold = True

Cells(n; 17) = (100 / Cells(n; 11) - 1) * 36500 / Cells(n; 5)

mas(1) = mas(1) + Cells(n; 5) * Cells(n; 9) * Cells(n; 14)

mas(2) = mas(2) + Cells(n; 5) * Cells(n; 9) * Cells(n; 16)

mas(3) = mas(3) + Cells(n; 5) * Cells(n; 9)

End If

n = n + 1

End If

i = i + 1

Loop

If Flag Then

MsgBox "Биржевой информации нет"

Exit Sub

End If

Num = n

Range(Cells(7; 1); Cells(Num - 1; 17)).Borders(xlLeft).Weight = xlThin

Range(Cells(7; 1); Cells(Num - 1; 17)).Borders(xlRight).Weight = xlThin

Range(Cells(7; 1); Cells(Num - 1; 17)).Borders(xlTop).Weight = xlThin

Range(Cells(7; 1); Cells(Num - 1; 17)).Borders(xlBottom).Weight = xlThin

Range(Cells(7; 1); Cells(Num - 1; 17)).BorderAround Weight:=xlMedium

Cells(Num; 1) = "Итого"

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

Cells(Num; 1).HorizontalAlignment = xlCenter

Cells(Num; 14) = mas(1) / mas(3)

Cells(Num; 15) = mas(1) / mas(3) / 0,85

Cells(Num; 16) = mas(2) / mas(3)

Cells(Num; 16).Font.Bold = True

Cells(Num; 17) = mas(2) / mas(3) / 0,85

Range(Cells(Num; 14); Cells(Num; 17)).NumberFormat = "0,00"

For i = 1 To 3

mas(i) = 0

Next i

For i = 7 To Num - 1

mas(1) = mas(1) + Cells(i; 6)

mas(2) = mas(2) + Cells(i; 7)

mas(3) = mas(3) + Cells(i; 9)

Next

Cells(Num; 6) = mas(1)

Cells(Num; 6).NumberFormat = "# ##0"

Cells(Num; 7) = mas(2)

Cells(Num; 9) = mas(3)

Cells(Num; 9).NumberFormat = "# ##0"

Cells(Num; 8) = mas(3) / mas(1) * 100

Cells(Num; 8).NumberFormat = "0,00"

Cells(Num; 7).Font.Bold = True

Cells(Num; 9).Font.Bold = True

Range(Cells(Num; 1); Cells(Num; 17)).BorderAround Weight:=xlMedium

Range(Cells(Num; 1); Cells(Num; 17)).Interior.ColorIndex = 15

If DialogPrint("Биржевая Информация"; 1) Then Exit Sub

End Sub

'-------------------------------- Дата -----------------------------

Sub DateChange()

With DialogSheets("ДиалогДата")

.EditBoxes.Text = CurDate

.EditBoxes.InputType = 1

.Show

CurDate = Worksheets("Врем").Cells(1; 4)

If Button = False Then

CurDate = Date

Worksheets("Врем").Cells(1; 4) = CurDate

MsgBox "Дата восстановлена"

Else

If IsDate(.EditBoxes.Text) Then

CurDate = .EditBoxes.Text

MsgBox "Дата изменена"

Worksheets("Врем").Cells(1; 4) = CurDate

Exit Sub

End If

MsgBox "Ошибка при вводе даты"

End If

End With

End Sub

'-------------------------------- Формирование текущей таблицы бумаг ----

Sub FormBum()

Dim L As Object

Dim i; k As Integer

Set L = Worksheets("Бумаги")

CurDate = Worksheets("Врем").Cells(1; 4)

i = 2

k = 1

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

If L.Cells(i; 2) <= CurDate And L.Cells(i; 3) >= CurDate Then

Worksheets("Врем").Cells(k; 1) = L.Cells(i; 1)

k = k + 1

End If

i = i + 1

Wend

Worksheets("Врем").Cells(1; 2) = k - 1

Set L = Worksheets("Клиенты")

i = 1

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

i = i + 1

Wend

Worksheets("Врем").Cells(1; 3) = i - 2

End Sub

' ------------------------------- Остатки на бирже --------------------

Sub EditOstBirga(CliNum As Long)

Dim ComBirga; sum; OstBegin As Double

Dim DoFlag As Boolean

Dim Sheet; Sheet1 As Object

Dim i; k; RowNum As Long

Set Sheet = Worksheets("ОстаткиБиржа")

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

CurDate = Worksheets("Врем").Cells(1; 4)

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

Sheet.Range("B2").Sort Key1:=Sheet.Range("B2"); Order1:=xlAscending; _

Key2:=Sheet.Range("A2"); Order2:=xlDescending; _

Header:=xlYes; OrderCustom:=1; _

MatchCase:=False; Orientation:=xlTopToBottom

OstBegin = 0

RowNum = 0

k = 2

DoFlag = True

Do While Sheet.Cells(k; 1) <> Empty

If Sheet.Cells(k; 2) = CliNum And DoFlag Then

If Sheet.Cells(k; 1) < CurDate Then

OstBegin = Sheet.Cells(k; 6)

Else

Do While Sheet.Cells(k; 1) <> Empty

If Sheet.Cells(k; 2) <> CliNum Then Exit Do

If Sheet.Cells(k; 1) = CurDate Then

OstBegin = Sheet.Cells(k; 3)

RowNum = k

Exit Do

End If

k = k + 1

Loop

End If

DoFlag = False

End If

k = k + 1

Loop

If RowNum = 0 Then RowNum = k

k = RowNum

sum = 0

i = 2

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

If Sheet1.Cells(i; 1) = CurDate And Sheet1.Cells(i; 2) = CliNum Then

If Sheet1.Cells(i; 4) <> Empty Then

sum = sum - _

Sheet1.Cells(i; 4) * Sheet1.Cells(i; 6) * 10000 - _

Format(Sheet1.Cells(i; 4) * Sheet1.Cells(i; 6) * 100 * ComBirga + 0,0001; "0,00")

Else

If Sheet1.Cells(i; 5) = 100 Then ComBirga = 0