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 = 2 To nrow1 If Worksheets("Кто едет").Cells(i, 3) Like "*переводчик*" Then Worksheets("Кто едет").Cells(i, 5) = Worksheets("Кто едет").Cells(i, 3) End If Next i 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 Worksheets("Кто едет").Cells(k, 4).Interior.Color = RGB(255, 204, 204) Rows(k).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Exit For End If Next k End If Next j Next i End Sub Sub список_переводчиков() 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 clear() For i = 2 To 1700 If Cells(i, 1) Like "*переводчик*" Then Cells(i, 1) = "" Cells(i, 2) = "" Cells(i, 3) = "" End If Next i End Sub