Sub edit_work_data Êîïèðîâàíèå òàáëèöû Êîìàíäèðîâêè ñîõðàíåíèåì øèðèíû

  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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
Sub edit_work_data()
''Êîïèðîâàíèå òàáëèöû "Êîìàíäèðîâêè" ñ ñîõðàíåíèåì øèðèíû è âûñîòû ÿ÷ååê íà íîâûé ëèñò
ncol = Worksheets("Êîìàíäèðîâêè").Cells(1, 1).CurrentRegion.Columns.Count
nrow = Worksheets("Êîìàíäèðîâêè").Cells(1, 1).CurrentRegion.Rows.Count
Dim RowHt As Single
RowHt = Cells(1, 1).RowHeight
Worksheets("Êîìàíäèðîâêè").Range(Cells(1, 1), Cells(nrow, ncol)).Copy
Worksheets.Add.Name = "Êîððåêöèÿ"
Worksheets("Êîððåêöèÿ").Cells(1, 1).PasteSpecial
Worksheets("Êîððåêöèÿ").Cells(1, 1).PasteSpecial Paste:=xlPasteColumnWidths
Cells(1, 1).RowHeight = RowHt
''Êîððåêöèÿ ñðîêîâ êîìàíäèðîâîê
Application.ScreenUpdating = False
Dim i As Integer, j As Integer
For i = 2 To 298
For j = 2 To 9
If Worksheets("Êîððåêöèÿ").Cells(i, 4) = Worksheets("Ñïèñîê öåëåé").Cells(j, 1) And Worksheets("Êîððåêöèÿ").Cells(i, 3) > Worksheets("Ñïèñîê öåëåé").Cells(j, 2) Then
Worksheets("Êîððåêöèÿ").Cells(i, 3) = Worksheets("Ñïèñîê öåëåé").Cells(j, 2)
Worksheets("Êîððåêöèÿ").Cells(i, 3).Interior.Color = RGB(255, 204, 204)
End If
Next j
Next i
End Sub
Sub edit_work_people()
ncol = Worksheets("Êîððåêöèÿ").Cells(1, 1).CurrentRegion.Columns.Count
nrow = Worksheets("Êîððåêöèÿ").Cells(1, 1).CurrentRegion.Rows.Count
ncol1 = Worksheets("Êòî åäåò").Cells(1, 1).CurrentRegion.Columns.Count
nrow1 = Worksheets("Êòî åäåò").Cells(1, 1).CurrentRegion.Rows.Count
Worksheets.Add.Name = "Ñïèñîêû"
Application.ScreenUpdating = False
''äîáàâëÿåì êîëîíêó "äîëæíîñòü" â ïîëíûé ñïèñîê ðàáîòíèêîâ
nrow2 = Worksheets("ÇÀÎ ""Ñòðîèòåëü""").Cells(1, 1).CurrentRegion.Rows.Count
nrow3 = Worksheets("ÍÈÈ ""Ðàññâåò""").Cells(1, 1).CurrentRegion.Rows.Count
For i = 2 To nrow1
For j = 2 To nrow2 + nrow3
If Worksheets("Êòî åäåò").Cells(i, 2) = Worksheets("ÇÀÎ ""Ñòðîèòåëü""").Cells(j, 1) Then
Worksheets("Êòî åäåò").Cells(i, 3) = Worksheets("ÇÀÎ ""Ñòðîèòåëü""").Cells(j, 4)
ElseIf Worksheets("Êòî åäåò").Cells(i, 2) = Worksheets("ÍÈÈ ""Ðàññâåò""").Cells(j, 1) Then
Worksheets("Êòî åäåò").Cells(i, 3) = Worksheets("ÍÈÈ ""Ðàññâåò""").Cells(j, 4)
ElseIf Worksheets("Êòî åäåò").Cells(i, 2) = Worksheets("Ïðèãëàøåííûå ñïåöèàëèñòû").Cells(j, 1) Then
Worksheets("Êòî åäåò").Cells(i, 3) = Worksheets("Ïðèãëàøåííûå ñïåöèàëèñòû").Cells(j, 3)
End If
Next j
Next i
''çàïîëíÿåì òàáëèöó êîìàíäèðîâîê ñ ñîñòàâîì ðàáîòíèêîâ
k = 1
Dim RowHt As Single
RowHt = Worksheets("Êîððåêöèÿ").Cells(1, 4).RowHeight
For i = 2 To nrow
For j = 2 To nrow1
If Worksheets("Êîððåêöèÿ").Cells(i, 1) = Worksheets("Êòî åäåò").Cells(j, 1) Then
Worksheets("Ñïèñîêû").Cells(k, 6) = Worksheets("Êòî åäåò").Cells(j, 2)
Worksheets("Ñïèñîêû").Cells(k, 1) = Worksheets("Êîððåêöèÿ").Cells(i, 4)
Worksheets("Ñïèñîêû").Cells(k, 3) = Worksheets("Êîððåêöèÿ").Cells(i, 2)
Worksheets("Ñïèñîêû").Cells(k, 2) = Worksheets("Êîððåêöèÿ").Cells(i, 1)
Worksheets("Ñïèñîêû").Cells(k, 3).NumberFormat = "dd/mm/yy"
Worksheets("Ñïèñîêû").Cells(k, 4) = Worksheets("Êîððåêöèÿ").Cells(i, 5)
Worksheets("Ñïèñîêû").Cells(k, 7) = Worksheets("Êòî åäåò").Cells(j, 3)
k = k + 1
End If
Next j
Next i
last = Worksheets("Ñïèñîêû").Cells(1, 1).CurrentRegion.Rows.Count
For i = 1 To last
For j = i + 1 To last
If Worksheets("Ñïèñîêû").Cells(i, 1) = Worksheets("Ñïèñîêû").Cells(j, 1) Then
Worksheets("Ñïèñîêû").Cells(j, 1) = ""
Worksheets("Ñïèñîêû").Cells(j, 2) = ""
Worksheets("Ñïèñîêû").Cells(j, 3) = ""
Worksheets("Ñïèñîêû").Cells(j, 4) = ""
Else: Exit For
End If
Next j
Next i
Worksheets("Ñïèñîêû").Cells(1, 1).EntireColumn.AutoFit
Worksheets("Ñïèñîêû").Cells(1, 5).EntireColumn.AutoFit
Worksheets("Ñïèñîêû").Cells(1, 3).EntireColumn.AutoFit
End Sub
Sub macro_çàãðàíèöà()
nrow1 = Worksheets("Êòî åäåò").Cells(1, 1).CurrentRegion.Rows.Count
last1 = Worksheets("Ñïèñîêû").Cells(1, 5).CurrentRegion.Rows.Count
last2 = Worksheets("Ñïèñîê ãîðîäîâ âíå").Cells(1, 1).CurrentRegion.Rows.Count
Application.ScreenUpdating = False
For i = 1 To last1
For j = 1 To last2
If Worksheets("Ñïèñîêû").Cells(i, 4) = Worksheets("Ñïèñîê ãîðîäîâ âíå").Cells(j, 1) Then
Worksheets("Ñïèñîêû").Cells(i, 5) = "çàãðàíèöó"
End If
Next j
Next i
End Sub
Sub Find_n_Highlight()
nrow1 = Worksheets("Êòî åäåò").Cells(1, 1).CurrentRegion.Rows.Count
last1 = Worksheets("Êîððåêöèÿ").Cells(2, 5).CurrentRegion.Rows.Count
last2 = Worksheets("Ñïèñîê ãîðîäîâ âíå").Cells(1, 1).CurrentRegion.Rows.Count
Application.ScreenUpdating = False
nrow1 = Worksheets("Êòî åäåò").Cells(2, 3).CurrentRegion.Rows.Count
''Âûäåëåíèå ñòðîêè äëÿ ïåðåâîä÷èêà â çàãðàíè÷íîé êîìàíäèðîâêå
For i = 1 To nrow1
For j = 1 To last2
If Worksheets("Ñïèñîêû").Cells(i, 4) = Worksheets("Ñïèñîê ãîðîäîâ âíå").Cells(j, 1) Then
Worksheets("Ñïèñîêû").Cells(i, 5) = "çàãðàíèöó"
For k = 2 To nrow1
If Worksheets("Êòî åäåò").Cells(k, 1) = Worksheets("Ñïèñîêû").Cells(i, 2) Then
Rows(k).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Exit For
End If
Next k
End If
Next j
Next i
''Âñòàâêà ñëó÷àéíîãî ïåðåâîä÷èêà â îòâåäåííóþ ñòðîêó
nrow1 = 1700
k = 1
For i = 2 To nrow1
If Worksheets("Êòî åäåò").Cells(i, 3) Like "*ïåðåâîä÷èê*" Then
Cells(k, 7) = Cells(i, 1)
Cells(k, 8) = Cells(i, 2)
Cells(k, 9) = Cells(i, 3)
k = k + 1
End If
Next i
nrow2 = Worksheets("Êòî åäåò").Cells(1, 7).CurrentRegion.Rows.Count
For i = 1 To 1700
If Worksheets("Êòî åäåò").Cells(i, 1) = "" Then
a = Int((nrow2 * Rnd()) + 1)
Range(Cells(a, 8), Cells(a, 9)).Copy
Cells(i, 2).PasteSpecial
End If
Next i
End Sub
Sub ñðîêè()
' Declare const ""
Const quote As String = """"
Set Trips = Worksheets("Êòî åäåò")
Set Dates = Worksheets("Êîìàíäèðîâêè")
Dim Emploees_Array As New Dictionary
' Declare array of company
Dim Company_Array(2) As String
Dim Trips_Array() As String
' Add name of company in array
Company_Array(0) = "ÍÈÈ " & quote & "Ðàññâåò" & quote
Company_Array(1) = "ÇÀÎ " & quote & "Ñòðîèòåëü" & quote
Company_Array(2) = "Ïðèãëàøåííûå ñïåöèàëèñòû"
For Each test In Company_Array
For i = 2 To Worksheets(test).Cells(2, 1).CurrentRegion.Rows.Count
Emploees_Array.Add Worksheets(test).Cells(i, 1).Value, Worksheets(test).Cells(i, 1)
Next
Next
For Each Worker In Emploees_Array
Enter = 0
For i = 2 To Trips.Cells(1, 1).CurrentRegion.Rows.Count
If Worker = Trips.Cells(i, 2) Then
Enter = Enter + 1
End If
Next
ReDim Trips_Array(Enter)
Key = 0
For i = 2 To Trips.Cells(1, 1).CurrentRegion.Rows.Count
If Worker = Trips.Cells(i, 2) Then
Trips_Array(Key) = Trips.Cells(i, 1)
Key = Key + 1
End If
Next
Emploees_Array.Item(Worker) = Trips_Array
Next
For Each Worker In Emploees_Array
Date_End = 1
For Each Number In Emploees_Array.Item(Worker)
'MsgBox (Number)
For i = 2 To Dates.Cells(1, 1).CurrentRegion.Rows.Count
' Íåÿâíîå ïðåîáðàçîâàíèå òèïà (Cstr)
If Dates.Cells(i, 1).Value = CStr(Number) Then
If Date_End <> 1 Then
If CDate(Dates.Cells(i, 2)) < CDate(Date_End) Then
For j = 2 To Trips.Cells(1, 1).CurrentRegion.Rows.Count
If (Trips.Cells(j, 1) = CStr(Number)) And (Trips.Cells(j, 2) = Worker) Then
Trips.Rows(j).Interior.Color = RGB(255, 204, 204)
End If
Next
End If
Else
Date_End = Dates.Cells(i, 2) + Day(Dates.Cells(i, 3) + 1)
End If
End If
Next
Next
Next
End Sub