Sub Task7 Declare sheets Set Bad_Prices Worksheets Add Bad_Prices Name

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
Sub Task7()
' Declare sheets
Set Bad_Prices = Worksheets.Add
Bad_Prices.Name = "Нерентабельные командировки"
Set Good_Prices = Worksheets.Add
Good_Prices.Name = "Рентабельные командировки"
Set Prices = Worksheets.Add
Prices.Name = "Стоимость командировок"
Set Trips = Worksheets("Все командировки")
' Declare array
Dim Location_Array(1) As String
Dim Price_Array(1) As String
Dim Price_Trips As New Dictionary
' Add name of company in array
Location_Array(0) = "Список областей"
Location_Array(1) = "Список стран"
For Each test In Location_Array
For i = 2 To Worksheets(test).Cells(2, 1).CurrentRegion.Rows.Count
If Worksheets(test).Cells(i, 2) = "" Then
Price_Array(0) = "1500"
Else
Price_Array(0) = Worksheets(test).Cells(i, 2)
End If
Price_Array(1) = Worksheets(test).Cells(i, 3)
Price_Trips.Add Worksheets(test).Cells(i, 1).Value, Price_Array
Next
Next
Enter1 = 1
Bad_Enter = 2
Good_Enter = 2
Enter = 0
For i = 2 To Trips.Cells(2, 1).CurrentRegion.Rows.Count
Enter = Enter + 1
If Trips.Cells(i, 1) <> Trips.Cells(i + 1, 1) Then
Enter1 = Enter1 + 1
MsgBox (Trips.Cells(i, 8))
Name_Location = Split(Trips.Cells(i, 8), "(")
MsgBox ("Тест")
New_Name_Location = Mid(Name_Location(1), 1, Len(Name_Location(1)) - 1)
Prices.Cells(Enter1, 1) = Trips.Cells(i, 1)
Prices.Cells(Enter1, 2) = Trips.Cells(i, 4)
Prices.Cells(Enter1, 3) = CDate(Trips.Cells(i, 5))
Prices.Cells(Enter1, 4) = CDate(Trips.Cells(i, 6))
Prices.Cells(Enter1, 5) = Trips.Cells(i, 7)
Prices.Cells(Enter1, 6) = Trips.Cells(i, 8)
Prices.Cells(Enter1, 7) = Enter
Prices.Cells(Enter1, 8) = Price_Trips.Item(New_Name_Location)(0)
Prices.Cells(Enter1, 9) = Price_Trips.Item(New_Name_Location)(1)
Sum = (Price_Trips.Item(New_Name_Location)(0) * Trips.Cells(i, 7) + Price_Trips.Item(New_Name_Location)(1)) * Enter
Prices.Cells(Enter1, 10) = Sum
Prices.Cells(Enter1, 10).Interior.Color = RGB(255, 188, 130)
Enter = 0
Difference = Trips.Cells(i, 9) - Sum
Prices.Cells(Enter1, 11) = Difference
If Difference < 100000 Then
If Difference < 0 Then
Bad_Prices.Cells(Bad_Enter, 11).Interior.Color = RGB(255, 94, 85)
Prices.Cells(Enter1, 11).Interior.Color = RGB(255, 94, 85)
Else
Prices.Cells(Enter1, 11).Interior.Color = RGB(255, 232, 150)
End If
Bad_Prices.Cells(Bad_Enter, 1) = Trips.Cells(i, 1)
Bad_Prices.Cells(Bad_Enter, 2) = Trips.Cells(i, 4)
Bad_Prices.Cells(Bad_Enter, 3) = CDate(Trips.Cells(i, 5))
Bad_Prices.Cells(Bad_Enter, 4) = CDate(Trips.Cells(i, 6))
Bad_Prices.Cells(Bad_Enter, 5) = Trips.Cells(i, 7)
Bad_Prices.Cells(Bad_Enter, 6) = Trips.Cells(i, 8)
Bad_Prices.Cells(Bad_Enter, 7) = Enter
Bad_Prices.Cells(Bad_Enter, 8) = Price_Trips.Item(New_Name_Location)(0)
Bad_Prices.Cells(Bad_Enter, 9) = Price_Trips.Item(New_Name_Location)(1)
Sum = (Price_Trips.Item(New_Name_Location)(0) * Trips.Cells(i, 7) + Price_Trips.Item(New_Name_Location)(1)) * Enter
Bad_Prices.Cells(Bad_Enter, 10) = Sum
Bad_Prices.Cells(Bad_Enter, 11) = Difference
Bad_Enter = Bad_Enter + 1
End If
If Difference > 100000 Then
Good_Prices.Cells(Good_Enter, 1) = Trips.Cells(i, 1)
Good_Prices.Cells(Good_Enter, 2) = Trips.Cells(i, 4)
Good_Prices.Cells(Good_Enter, 3) = CDate(Trips.Cells(i, 5))
Good_Prices.Cells(Good_Enter, 4) = CDate(Trips.Cells(i, 6))
Good_Prices.Cells(Good_Enter, 5) = Trips.Cells(i, 7)
Good_Prices.Cells(Good_Enter, 6) = Trips.Cells(i, 8)
Good_Prices.Cells(Good_Enter, 7) = Enter
Good_Prices.Cells(Good_Enter, 8) = Price_Trips.Item(New_Name_Location)(0)
Good_Prices.Cells(Good_Enter, 9) = Price_Trips.Item(New_Name_Location)(1)
Sum = (Price_Trips.Item(New_Name_Location)(0) * Trips.Cells(i, 7) + Price_Trips.Item(New_Name_Location)(1)) * Enter
Good_Prices.Cells(Good_Enter, 10) = Sum
Good_Prices.Cells(Good_Enter, 11) = Difference
Good_Enter = Good_Enter + 1
End If
Prices.Cells(Enter1, 10) = Difference
End If
Next
Dim Name_Sheets(2) As String
Name_Sheets(0) = "Нерентабельные командировки"
Name_Sheets(1) = "Рентабельные командировки"
Name_Sheets(2) = "Стоимость командировок"
' Design WorkSheets
Enter = 1
For Each Name In Name_Sheets
Worksheets(Name).Cells(1, 1) = "№ команд."
Worksheets(Name).Cells(1, 2) = "Цель командировки"
Worksheets(Name).Cells(1, 3) = "Начало команд."
Worksheets(Name).Cells(1, 4) = "Конец команд."
Worksheets(Name).Cells(1, 5) = "Кол. дней"
Worksheets(Name).Cells(1, 6) = "Место командировки"
Worksheets(Name).Cells(1, 7) = "Кол-во сот."
Worksheets(Name).Cells(1, 8) = "Суточная цена"
Worksheets(Name).Cells(1, 9) = "Цена за проезд"
Worksheets(Name).Cells(1, 10) = "Общая стоимость"
Worksheets(Name).Cells(1, 11) = "Рентабельность"
If Name <> "Стоимость командировок" Then
Worksheets(Name).Columns(7).Delete
Worksheets(Name).Columns(9).Delete
Else
Worksheets(Name).Cells(1, 10).Interior.Color = RGB(255, 166, 89)
End If
Worksheets(Name).Rows(1).RowHeight = 25
Worksheets(Name).Rows(1).Interior.Color = RGB(205, 195, 255)
Worksheets(Name).Range(Worksheets(Name).Cells(1, 1), Worksheets(Name).Cells(1, Worksheets(Name).Cells(1, 1).CurrentRegion.Columns.Count)).EntireColumn.AutoFit
Next
End Sub