Код:
Sub vvvky3()
Dim n As Long, i As Long, i0 As Long, j As Long
Dim strTxt As String, k As Integer
i0 = 2
ncolumn = Cells.Find(What:="№ операции", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
ncolumn3 = Cells.Find(What:="Код операции стал", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns).Column
n = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
For i = 3 To n
If ActiveSheet.Cells(i, ncolumn).Value = 5 Or i = n Then
If i = n Then i = i + 1
strTxt = ActiveSheet.Cells(i0, ncolumn3).Value
For j = i0 + 1 To i - 2
strTxt = strTxt & "-" & ActiveSheet.Cells(j, ncolumn3).Value
Next j
k = 0
Do
k = k + 1
Loop While IsNumeric(Right(ActiveSheet.Cells(i - 1, ncolumn3).Value, k)) And Len(ActiveSheet.Cells(i - 1, ncolumn3).Value) < k
strTxt = strTxt & "-" & Left(ActiveSheet.Cells(i - 1, ncolumn3).Value, k)
k = Val(Right(ActiveSheet.Cells(i - 1, ncolumn3).Value, k))
For j = i - 1 To i0 Step -1
If k >= 0 Then ActiveSheet.Cells(j, ncolumn3 + 2).Value = strTxt & k Else ActiveSheet.Cells(j, ncolumn3 + 2).Value = strTxt & (-k)
k = k - 1
Next
i0 = i
End If
Next i
End Sub
