Добрый день! Помогите пожалуйста! Есть большая таблица в которой нужно значения отмеченные синем переместить на строчку ниже в желтую и аналогично через 3 строчки...
Добрый день! Помогите пожалуйста! Есть большая таблица в которой нужно значения отмеченные синем переместить на строчку ниже в желтую и аналогично через 3 строчки...Forth
Sub d() n = Cells(Rows.Count, 1).End(xlUp).Row + 1 r = Array("a", "d", "e") For i = 5 To n If Len(Cells(i, r(0))) = 0 Then For ii = 0 To UBound(r) Cells(i, r(ii)).Value = Cells(i, r(ii)).Offset(-1, 0).Value Cells(i, r(ii)).Offset(-1, 0).ClearContents Next End If Next End Sub
[/vba]
Можно макросом: [vba]
Код
Sub d() n = Cells(Rows.Count, 1).End(xlUp).Row + 1 r = Array("a", "d", "e") For i = 5 To n If Len(Cells(i, r(0))) = 0 Then For ii = 0 To UBound(r) Cells(i, r(ii)).Value = Cells(i, r(ii)).Offset(-1, 0).Value Cells(i, r(ii)).Offset(-1, 0).ClearContents Next End If Next End Sub
макрасом круто, но оказываются есть строки не по 3, а более
Макрос не смотрит на количество строк. Он работает так: Если пустая ячейка в 1-м столбце, то он сдвигает значения из вышележащей строки в эту пустую строку - только в столбцах "a", "d", "e"
Можно но тогда меняется логика. Сейчас он копирует если находит пустую строку сверху. А по Вашему предложению будет копировать на строку ниже. Попробуйте на своих данных - если что - тогда поменяю.
макрасом круто, но оказываются есть строки не по 3, а более
Макрос не смотрит на количество строк. Он работает так: Если пустая ячейка в 1-м столбце, то он сдвигает значения из вышележащей строки в эту пустую строку - только в столбцах "a", "d", "e"
Можно но тогда меняется логика. Сейчас он копирует если находит пустую строку сверху. А по Вашему предложению будет копировать на строку ниже. Попробуйте на своих данных - если что - тогда поменяю. SLAVICK
Sub d() r = Array("i", "l", "m") n = Cells(Rows.Count, r(0)).End(xlUp).Row + 1 For i = n To 10 Step -1 If Len(Cells(i, r(0)).Value) = 0 Then t = i If Cells(i, r(0)).Value Like "8547-OFS*" Then For ii = LBound(r) To UBound(r) ' Cells(i, r(ii)).Offset(1, 0).Value = Cells(i, r(ii)).Value ' для смещения на одну строку вниз Cells(t, r(ii)).Value = Cells(i, r(ii)).Value ' для смещения в пустую ячейку внизу Cells(i, r(ii)).ClearContents Next End If Next End Sub
[/vba]
Тогда наверно так: [vba]
Код
Sub d() r = Array("i", "l", "m") n = Cells(Rows.Count, r(0)).End(xlUp).Row + 1 For i = n To 10 Step -1 If Len(Cells(i, r(0)).Value) = 0 Then t = i If Cells(i, r(0)).Value Like "8547-OFS*" Then For ii = LBound(r) To UBound(r) ' Cells(i, r(ii)).Offset(1, 0).Value = Cells(i, r(ii)).Value ' для смещения на одну строку вниз Cells(t, r(ii)).Value = Cells(i, r(ii)).Value ' для смещения в пустую ячейку внизу Cells(i, r(ii)).ClearContents Next End If Next End Sub