Анализ эффективности вложений денежных средств в РКО
Flag = TrueFor k = 1 To BumNum ' поиск номера бумаги
If Cells(i; 3) = Bum(k) Then
Flag = False
Exit For
End If
Next k
If Flag Then GoTo cont
Sign = 1
If IsEmpty(Cells(i; 4)) Then Sign = -1
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 1) = _
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 1) + Sign * Cells(i; 6)
End If
If Cells(i; 1) >= DateBegin And DateFlag Then
For k = 1 To NumberClients
For m = 1 To BumNum
mas(k; (m - 1) * 7 + 2) = mas(k; (m - 1) * 7 + 1)
Next m
Next k
DateFlag = False
End If
If Cells(i; 1) >= DateBegin And Cells(i; 1) <= DateEnd 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 Cells(i; 7) <> "списание" And Cells(i; 7) <> "зачисление" Then
If Not IsEmpty(Cells(i; 4)) Then
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 3) = _
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 3) + Cells(i; 6)
Else
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 4) = _
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 4) + Cells(i; 6)
End If
If DateMas(Cells(i; 2) - DilerConst; k) <> Cells(i; 1) Then
DateMas(Cells(i; 2) - DilerConst; k) = Cells(i; 1)
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 5) = _
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 5) + 1
End If
End If
If Cells(i; 7) = "списание" Then
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 6) = _
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 6) + Cells(i; 6)
End If
If Cells(i; 7) = "зачисление" Then
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 7) = _
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 7) + Cells(i; 6)
End If
Sign = 1
If IsEmpty(Cells(i; 4)) Then Sign = -1
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 2) = _
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 2) + Sign * Cells(i; 6)
End If
End If
cont:
i = i + 1
Wend
For i = 1 To NumberClients
CliInput(i) = False
For k = 1 To BumNum
If mas(i; (k - 1) * 7 + 1) > 0 Or _
mas(i; (k - 1) * 7 + 2) > 0 Or _
mas(i; (k - 1) * 7 + 3) > 0 Or _
mas(i; (k - 1) * 7 + 4) > 0 Or _
mas(i; (k - 1) * 7 + 5) > 0 Or _
mas(i; (k - 1) * 7 + 6) > 0 Or _
mas(i; (k - 1) * 7 + 7) > 0 Then CliInput(i) = True
Next k
Next i
For k = 1 To BumNum
BumInput(k) = False
For i = 1 To NumberClients
If mas(i; (k - 1) * 7 + 1) > 0 Or _
mas(i; (k - 1) * 7 + 2) > 0 Or _
mas(i; (k - 1) * 7 + 3) > 0 Or _
mas(i; (k - 1) * 7 + 4) > 0 Or _
mas(i; (k - 1) * 7 + 5) > 0 Or _
mas(i; (k - 1) * 7 + 6) > 0 Or _
mas(i; (k - 1) * 7 + 7) > 0 Then BumInput(k) = True
Next i
Next k
Worksheets("ОтчетМесячный").Select
Range(Cells(7; 1); Cells(800; 22)).Delete shift:=xlToLeft
Row = 4
Col = 2
Cells(2; 1) = "за период от " + CStr(DateBegin) + " до " + CStr(DateEnd)
kk = 0
Flag = False
For k = 1 To BumNum
If BumInput(k) Then
Cells(Row; Col) = Bum(k)
Num = 0
For i = 1 To NumberClients
If CliInput(i) Then
If Col = 2 Then
Str = Format(i; "0000000000")
Str = Right(Str; 5)
Cells(Row + Num + 3; Col - 1).NumberFormat = "@"
Cells(Row + Num + 3; Col - 1).Font.Bold = True
Cells(Row + Num + 3; Col - 1).HorizontalAlignment = xlCenter
Cells(Row + Num + 3; Col - 1).Font.Italic = False
Cells(Row + Num + 3; Col - 1).Interior.ColorIndex = 2
Cells(Row + Num + 3; Col - 1) = Str
End If
Cells(Row + Num + 3; Col) = mas(i; (k - 1) * 7 + 1)
Cells(Row + Num + 3; Col + 1) = mas(i; (k - 1) * 7 + 2)
Cells(Row + Num + 3; Col + 2) = mas(i; (k - 1) * 7 + 3)
Cells(Row + Num + 3; Col + 3) = mas(i; (k - 1) * 7 + 4)
Cells(Row + Num + 3; Col + 4) = mas(i; (k - 1) * 7 + 5)
Cells(Row + Num + 3; Col + 5) = mas(i; (k - 1) * 7 + 6)
Cells(Row + Num + 3; Col + 6) = mas(i; (k - 1) * 7 + 7)
Num = Num + 1
End If
Next i
Col = Col + 7
kk = kk + 1
Flag = True
End If
If ((kk > 0) And (kk Mod 3 = 0) And Flag) Or k = BumNum Then
Flag = False
For i = 2 To 22
sum = 0
For m = 1 To NumberClients
sum = sum + Cells(m + 6; i)
Next m
Cells(Num + 7; i) = sum
Cells(Num + 7; i).Font.Bold = True
Cells(Num + 7; i).Interior.ColorIndex = 15
Next i
Cells(Num + 7; 1) = "Итого"
Cells(Num + 7; 1).Font.Bold = True
Cells(Num + 7; 1).HorizontalAlignment = xlCenter
Cells(Num + 7; 1).Interior.ColorIndex = 15
Range(Cells(7; 1); Cells(Num + 7; 22)).Borders(xlLeft).Weight = xlThin
Range(Cells(7; 1); Cells(Num + 7; 22)).Borders(xlRight).Weight = xlThin
Range(Cells(7; 1); Cells(Num + 7; 22)).Borders(xlTop).Weight = xlThin
Range(Cells(7; 1); Cells(Num + 7; 22)).Borders(xlBottom).Weight = xlThin
Range(Cells(7; 1); Cells(Num + 7; 22)).BorderAround Weight:=xlMedium
Range(Cells(7; 9); Cells(Num + 7; 15)).BorderAround Weight:=xlMedium
Cells(Num + 10; 10) = "Ответственное лицо Дилера______________________________"
If DialogPrint("ОтчетМесячный"; 2) Then Exit Sub
Row = 4
Col = 2
Cells(Row; Col) = " "
Cells(Row; Col + 7) = " "
Cells(Row; Col + 14) = " "
Range(Cells(7; 1); Cells(800; 22)).Delete shift:=xlToLeft
End If
Next k
Worksheets("СписокКлиентов").Select
Num = 5
Range(Cells(Num; 1); Cells(100; 3)).Delete shift:=xlToLeft
For i = 1 To NumberClients
If CliInput(i) Then
k = 2
While Sheet.Cells(k; 2) <> DilerConst + i
k = k + 1
Wend
Cells(Num; 1) = Sheet.Cells(k; 1)
Cells(Num; 2) = Sheet.Cells(k; 2)
Cells(Num; 3) = Sheet.Cells(k; 3)
Cells(Num; 1).HorizontalAlignment = xlLeft
Cells(Num; 2).HorizontalAlignment = xlCenter
Cells(Num; 3).HorizontalAlignment = xlCenter
Cells(Num; 3).WrapText = True
Num = Num + 1
End If
Next i
Cells(2; 1) = "за период от " + CStr(DateBegin) + " до " + CStr(DateEnd)
Range(Cells(5; 1); Cells(Num - 1; 3)).Borders(xlLeft).Weight = xlThin
Range(Cells(5; 1); Cells(Num - 1; 3)).Borders(xlRight).Weight = xlThin
Range(Cells(5; 1); Cells(Num - 1; 3)).Borders(xlTop).Weight = xlThin
Range(Cells(5; 1); Cells(Num - 1; 3)).Borders(xlBottom).Weight = xlThin
Range(Cells(5; 1); Cells(Num - 1; 3)).BorderAround Weight:=xlMedium
Range(Cells(5; 2); Cells(Num - 1; 2)).BorderAround Weight:=xlMedium
Cells(Num + 2; 2) = "Ответственное лицо Дилера______________________________"
With DialogSheets("ДиалогПечать")
AgainMonthOtch1:
Просмотр = False
ExitVar = False
Button = False
.Show
If Просмотр Then
Worksheets("СписокКлиентов").PrintPreview
GoTo AgainMonthOtch1
End If
If ExitVar Then Exit Sub
If Button Then ActiveWindow.SelectedSheets.PrintOut copies:=2
End With
End Sub
'-------------------------------- Перечисление/списание биржа ------
Sub GotoBirga()
Dim Sheet As Object
Dim OstIn; OstOut; OstBegin; CliNum As Double
Dim RowNum; k As Long
Dim DoFlag As Boolean
Set Sheet = Worksheets("ОстаткиБиржа")
Sheet.Range("B2").Sort Key1:=Sheet.Range("B2"); Order1:=xlAscending; _
Key2:=Sheet.Range("A2"); Order2:=xlDescending; _
Header:=xlYes; OrderCustom:=1; _
MatchCase:=False; Orientation:=xlTopToBottom
Sheet.Select
CurDate = Worksheets("Врем").Cells(1; 4)
k = 2
While Worksheets("Клиенты").Cells(k; 1) <> Empty
k = k + 1
Wend
With DialogSheets("ДиалогБиржа")
.DropDowns.ListFillRange = "Клиенты!$B$2:$B$" + CStr(k - 1)
.EditBoxes(1).InputType = xlNumber
.EditBoxes(2).InputType = xlNumber
.Show
If Button = False Then
MsgBox "Данные не занесены"
Exit Sub
End If
CliNum = .DropDowns(1).List(.DropDowns(1).ListIndex)
If .EditBoxes(1).Text = "" Then
OstIn = 0
Else
OstIn = .EditBoxes(1).Text
End If
If .EditBoxes(2).Text = "" Then
OstOut = 0
Else
OstOut = .EditBoxes(2).Text
End If
OstBegin = 0
k = 2
DoFlag = True
Do While Cells(k; 1) <> Empty
If Cells(k; 2) = CliNum And DoFlag Then
If Cells(k; 1) < CurDate Then
OstBegin = Cells(k; 6)
Else
MsgBox "Невозможен ввод информации"
Exit Sub
End If