Данные строки графика читаются в массив, диапазон очищается, значения пишутся со сдвигом. Первые shiftDays ячеек получают «Т» (дни пути). Цвета не копируйте по одной ячейке — повесьте FormatConditions: оранжевый для «Т», зелёный для чисел 1–16. Правило «любое число > 0 → белый фон» добавляйте последним: у условного форматирования ниже приоритет у правил, добавленных позже, иначе оно перебьёт зелёный. Жёсткая колонка 634 (ADP) — граница года в конкретной книге; в общем шаблоне лучше считать End(xlToLeft).
Сдвинуть график вправо и залить дни пути
Вахтовый график в строке нужно сдвинуть на N дней, первые ячейки заполнить «Т», цвета вернуть условным форматированием.
Код
Sub ShiftScheduleRight(ByVal startAddress As String, ByVal shiftDays As Integer)
Dim ws As Worksheet
Dim startCell As Range
Dim startCol As Long, endCol As Long, rowSchedule As Long
Dim i As Long, newCol As Long, totalCols As Long
Dim dataArray() As Variant
Set ws = ActiveSheet
Set startCell = ws.Range(startAddress)
rowSchedule = 4
startCol = startCell.Column
endCol = ws.Cells(rowSchedule, ws.Columns.Count).End(xlToLeft).Column
If endCol < startCol + shiftDays + 100 Then endCol = 634
If startCol + shiftDays > endCol Then
MsgBox "Сдвиг слишком большой: график выйдет за пределы листа.", vbCritical
Exit Sub
End If
totalCols = endCol - startCol + 1
ReDim dataArray(1 To totalCols)
For i = 1 To totalCols
dataArray(i) = ws.Cells(rowSchedule, startCol + i - 1).Value
Next i
ws.Range(ws.Cells(rowSchedule, startCol), ws.Cells(rowSchedule, endCol)).ClearContents
For i = 1 To totalCols
newCol = startCol + i - 1 + shiftDays
If newCol <= endCol Then ws.Cells(rowSchedule, newCol).Value = dataArray(i)
Next i
For i = 0 To shiftDays - 1
If startCol + i <= endCol Then ws.Cells(rowSchedule, startCol + i).Value = "Т"
Next i
ApplyColors ws, rowSchedule, startCol, endCol
MsgBox "График сдвинут вправо на " & shiftDays & " дн.", vbInformation
End Sub
Sub ApplyColors(ws As Worksheet, ByVal rowNum As Long, ByVal startCol As Long, ByVal endCol As Long)
Dim rng As Range
Set rng = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
rng.FormatConditions.Delete
With rng.FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""Т""")
.Interior.Color = RGB(255, 165, 0)
.Font.Color = RGB(0, 0, 0)
End With
With rng.FormatConditions.Add(Type:=xlCellValue, Operator:=xlBetween, Formula1:="=1", Formula2:="=16")
.Interior.Color = RGB(0, 176, 80)
.Font.Color = RGB(255, 255, 255)
End With
End Sub