Здравствуйте!
Есть макрос который всатвляет строки при условии, но оно соблюденно не полностью.
Нужно в колонке соблюсти обязательный порядок который контролируется последними цифрами в строке (10→20→30), елси нет какого-то из трех значений значит оно должно быть замененно пустой строчкой (пусто→20→30; 10→пусто→30; 10→20→пусто; 10→пусто→пусто; пусто→20→пусто; пусто→пусто→30 и т.д)
Sub Insert_Rows()
Dim yy As Long
Dim arr As Variant
yy = Cells(Rows.Count, 1).End(xlUp).Row
If yy = 1 Then Exit Sub
arr = Range(Cells(1, 1), Cells(yy, 1))
Dim Application_Calculation As Long
Application_Calculation = Application.Calculation
Application.Calculation = xlCalculationManual
For yy = UBound(arr, 1) To 2 Step -1
If Right(arr(yy, 1), 2) = "20" Then
Cells(yy + 1, 1).Resize(1).EntireRow.Insert
With Cells(yy + 1, 1).Resize(1, 1)
Cells(yy, 1).Resize(1, 2).Copy .Cells
.ClearContents
End With
ElseIf Right(arr(yy, 1), 2) = "10" Then
If Right(arr(yy - 1, 1), 2) = "30" Then
Cells(yy + 1, 1).EntireRow.Insert
yy = yy - 1
End If
End If
Next
Application.Calculation = Application_Calculation
End Sub
Есть макрос который всатвляет строки при условии, но оно соблюденно не полностью.
Нужно в колонке соблюсти обязательный порядок который контролируется последними цифрами в строке (10→20→30), елси нет какого-то из трех значений значит оно должно быть замененно пустой строчкой (пусто→20→30; 10→пусто→30; 10→20→пусто; 10→пусто→пусто; пусто→20→пусто; пусто→пусто→30 и т.д)
Sub Insert_Rows()
Dim yy As Long
Dim arr As Variant
yy = Cells(Rows.Count, 1).End(xlUp).Row
If yy = 1 Then Exit Sub
arr = Range(Cells(1, 1), Cells(yy, 1))
Dim Application_Calculation As Long
Application_Calculation = Application.Calculation
Application.Calculation = xlCalculationManual
For yy = UBound(arr, 1) To 2 Step -1
If Right(arr(yy, 1), 2) = "20" Then
Cells(yy + 1, 1).Resize(1).EntireRow.Insert
With Cells(yy + 1, 1).Resize(1, 1)
Cells(yy, 1).Resize(1, 2).Copy .Cells
.ClearContents
End With
ElseIf Right(arr(yy, 1), 2) = "10" Then
If Right(arr(yy - 1, 1), 2) = "30" Then
Cells(yy + 1, 1).EntireRow.Insert
yy = yy - 1
End If
End If
Next
Application.Calculation = Application_Calculation
End Sub