Ошибка: MsgBox "Данная строка не принадлежит таблице !", vbCritical, "Ошибка"
End Sub
[/vba]
Но есть несколько но: 1. Строка добавляется выше так как я и хочу, но вот незадача – появляются формулы, которых не должно быть (ячейки выделил выделил желтым цветом). 2. Там, где формулы должны быть их нет (выделил ячейки синим цветом). 3. Строка итогов (серый цвет) – в ней формулы не считают необходимый диапазон ЕСЛИ(ИЛИ(B10=B10);СУММ(H11:H14)), а должно быть ЕСЛИ(ИЛИ(B10=B10);СУММ(H11:H15)) (ячейки выделил (красным цветом). Появляется синяя стрелка в ячейке Н12 до ячейки Н16.
И самый главный вопрос, как можно в макрос добавить копирование диапазона ячеек (А5:М9) и по нажатию кнопки вставлять его, диапазон, выше активной ячейки, т.е. если курсор стоит в А17, то диапазон нужно вставить выше с сохранением формул, форматов и т.д.
Помогите пожалуйста.
Добрый вечер. Сразу прошу прощения - пишу с телефона. . На просторах форума нашел вот такой код.
[vba]
Код
Sub ДобавитьСтрокуВыше()
Dim ИмяТаблицы As String Dim УмнаяТаблица As ListObject Dim АктивнаяСтрока As Integer
On Error GoTo Ошибка
'Получаем имя таблицы а
ИмяТаблицы = ActiveSheet.ListObjects(1).Name
'Получаем умную таблицу
Set УмнаяТаблица = ActiveSheet.ListObjects(ИмяТаблицы)
Ошибка: MsgBox "Данная строка не принадлежит таблице !", vbCritical, "Ошибка"
End Sub
[/vba]
Но есть несколько но: 1. Строка добавляется выше так как я и хочу, но вот незадача – появляются формулы, которых не должно быть (ячейки выделил выделил желтым цветом). 2. Там, где формулы должны быть их нет (выделил ячейки синим цветом). 3. Строка итогов (серый цвет) – в ней формулы не считают необходимый диапазон ЕСЛИ(ИЛИ(B10=B10);СУММ(H11:H14)), а должно быть ЕСЛИ(ИЛИ(B10=B10);СУММ(H11:H15)) (ячейки выделил (красным цветом). Появляется синяя стрелка в ячейке Н12 до ячейки Н16.
И самый главный вопрос, как можно в макрос добавить копирование диапазона ячеек (А5:М9) и по нажатию кнопки вставлять его, диапазон, выше активной ячейки, т.е. если курсор стоит в А17, то диапазон нужно вставить выше с сохранением формул, форматов и т.д.
Sub tt() With ActiveSheet.ListObjects(1) Set d = Intersect(.Range, Selection) If d Is Nothing Then Exit Sub c_ = .Range.Column nc_ = .Range.Columns.Count r_ = d(1).Row End With With Cells(r_, c_).Resize(, nc_) .Copy .Insert Shift:=xlUp .Offset(-1).SpecialCells(xlCellTypeConstants, 23).ClearContents End With End Sub
Выдаёт ошибку вот в этой строке .Offset(-1).SpecialCells(xlCellTypeConstants, 23).ClearContents. Если удаляю SpecialCells(xlCellTypeConstants, 23) макрос работает, но тогда удаляются все формулы в ячейках, а мне этого не нужно. Пробовал Constants заменить на Formulas, но и это не помогает. В vba я не силен. Подскажите пожалуйста, в чем проблема. Спасибо.
Вот, нашёл ещё один код
Код
Sub tt() With ActiveSheet.ListObjects(1) Set d = Intersect(.Range, Selection) If d Is Nothing Then Exit Sub c_ = .Range.Column nc_ = .Range.Columns.Count r_ = d(1).Row End With With Cells(r_, c_).Resize(, nc_) .Copy .Insert Shift:=xlUp .Offset(-1).SpecialCells(xlCellTypeConstants, 23).ClearContents End With End Sub
Выдаёт ошибку вот в этой строке .Offset(-1).SpecialCells(xlCellTypeConstants, 23).ClearContents. Если удаляю SpecialCells(xlCellTypeConstants, 23) макрос работает, но тогда удаляются все формулы в ячейках, а мне этого не нужно. Пробовал Constants заменить на Formulas, но и это не помогает. В vba я не силен. Подскажите пожалуйста, в чем проблема. Спасибо.graffserg
Сообщение отредактировал graffserg - Понедельник, 12.09.2022, 10:22