Добрый день! Можно ли прописать код, в случаи когда ячейки объединены с колонки с B по R, тогда в колонку U вставить данные этой ячейки, иначе данные ячейки выше? Пример приложила
Добрый день! Можно ли прописать код, в случаи когда ячейки объединены с колонки с B по R, тогда в колонку U вставить данные этой ячейки, иначе данные ячейки выше? Пример приложилаElvira66
Sub Button1_Click() s = "" For i = 2 To Cells(Rows.Count, "R").End(xlUp).Row If Range("B" & CStr(i) & ":R" & i).MergeCells Then s = Cells(i, "B") Cells(i, "U") = s Next End Sub
[/vba]
[vba]
Код
Sub Button1_Click() s = "" For i = 2 To Cells(Rows.Count, "R").End(xlUp).Row If Range("B" & CStr(i) & ":R" & i).MergeCells Then s = Cells(i, "B") Cells(i, "U") = s Next End Sub
Sub обана() lr = ActiveSheet.Cells(Rows.Count, "R").End(xlUp).Row For f = 2 To lr If ActiveSheet.Cells(f, 2).MergeCells Then ActiveSheet.Cells(f, 21).Value = ActiveSheet.Cells(f, 2).Value Else: ActiveSheet.Cells(f, 21).Value = ActiveSheet.Cells(f - 1, 21).Value End If Next f End Sub
[/vba]
ну или так макросом
[vba]
Код
Sub обана() lr = ActiveSheet.Cells(Rows.Count, "R").End(xlUp).Row For f = 2 To lr If ActiveSheet.Cells(f, 2).MergeCells Then ActiveSheet.Cells(f, 21).Value = ActiveSheet.Cells(f, 2).Value Else: ActiveSheet.Cells(f, 21).Value = ActiveSheet.Cells(f - 1, 21).Value End If Next f End Sub
Sub ee() Application.ScreenUpdating = 0 Application.Calculation = 3 n_ = Cells(Rows.Count, "R").End(3).Row - 1 ar = Cells(2, "B").Resize(n_) For i = 1 To n_ If IsEmpty(ar(i, 1)) Then ar(i, 1) = ar(i - 1, 1) Next i Cells(2, "U").Resize(n_) = ar Application.Calculation = 1 Application.ScreenUpdating = 1 End Sub
[/vba]
Или вообще без цикла
[vba]
Код
Sub tt() Application.ScreenUpdating = 0 Application.Calculation = 3 n_ = Cells(Rows.Count, "R").End(3).Row - 1 With Cells(2, "U").Resize(n_) .NumberFormat = "General" .Value = Cells(2, "B").Resize(n_).Value .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C" .Value = .Value End With Application.Calculation = 1 Application.ScreenUpdating = 1 End Sub
[/vba]
Или так, без цикла по ячейкам
[vba]
Код
Sub ee() Application.ScreenUpdating = 0 Application.Calculation = 3 n_ = Cells(Rows.Count, "R").End(3).Row - 1 ar = Cells(2, "B").Resize(n_) For i = 1 To n_ If IsEmpty(ar(i, 1)) Then ar(i, 1) = ar(i - 1, 1) Next i Cells(2, "U").Resize(n_) = ar Application.Calculation = 1 Application.ScreenUpdating = 1 End Sub
[/vba]
Или вообще без цикла
[vba]
Код
Sub tt() Application.ScreenUpdating = 0 Application.Calculation = 3 n_ = Cells(Rows.Count, "R").End(3).Row - 1 With Cells(2, "U").Resize(n_) .NumberFormat = "General" .Value = Cells(2, "B").Resize(n_).Value .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C" .Value = .Value End With Application.Calculation = 1 Application.ScreenUpdating = 1 End Sub