Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Макрос копирования и вставки строки выше активной ячейки - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Макрос копирования и вставки строки выше активной ячейки
graffserg Дата: Суббота, 10.09.2022, 21:02 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 84
Репутация: 1 ±
Замечаний: 0% ±

2010
Добрый вечер. Сразу прошу прощения - пишу с телефона. . На просторах форума нашел вот такой код.

[vba]
Код
Sub ДобавитьСтрокуВыше()

Dim ИмяТаблицы As String
Dim УмнаяТаблица As ListObject
Dim АктивнаяСтрока As Integer
  
On Error GoTo Ошибка
  
'Получаем имя таблицы  а
  
ИмяТаблицы = ActiveSheet.ListObjects(1).Name

'Получаем умную таблицу
  
Set УмнаяТаблица = ActiveSheet.ListObjects(ИмяТаблицы)
  
'Получаем активную строку умной таблицы
  
АктивнаяСтрока = ActiveCell.Row - ActiveCell.ListObject.DataBodyRange.Row + 1
  
'Добавляем новую строку

    Selection.ListObject.ListRows.Add (АктивнаяСтрока)

  
Exit Sub
  
Ошибка:
      MsgBox "Данная строка не принадлежит таблице  !", vbCritical, "Ошибка"
       
End Sub
[/vba]

Но есть несколько но:
1. Строка добавляется выше так как я и хочу, но вот незадача – появляются формулы, которых не должно быть (ячейки выделил выделил желтым цветом).
2. Там, где формулы должны быть их нет (выделил ячейки синим цветом).
3. Строка итогов (серый цвет) – в ней формулы не считают необходимый диапазон ЕСЛИ(ИЛИ(B10=B10);СУММ(H11:H14)), а должно быть ЕСЛИ(ИЛИ(B10=B10);СУММ(H11:H15)) (ячейки выделил (красным цветом).
Появляется синяя стрелка в ячейке Н12 до ячейки Н16.

И самый главный вопрос, как можно в макрос добавить копирование диапазона ячеек (А5:М9) и по нажатию кнопки вставлять его, диапазон, выше активной ячейки, т.е. если курсор стоит в А17, то диапазон нужно вставить выше с сохранением формул, форматов и т.д.

Помогите пожалуйста.


Сообщение отредактировал graffserg - Суббота, 10.09.2022, 21:03
 
Ответить
СообщениеДобрый вечер. Сразу прошу прощения - пишу с телефона. . На просторах форума нашел вот такой код.

[vba]
Код
Sub ДобавитьСтрокуВыше()

Dim ИмяТаблицы As String
Dim УмнаяТаблица As ListObject
Dim АктивнаяСтрока As Integer
  
On Error GoTo Ошибка
  
'Получаем имя таблицы  а
  
ИмяТаблицы = ActiveSheet.ListObjects(1).Name

'Получаем умную таблицу
  
Set УмнаяТаблица = ActiveSheet.ListObjects(ИмяТаблицы)
  
'Получаем активную строку умной таблицы
  
АктивнаяСтрока = ActiveCell.Row - ActiveCell.ListObject.DataBodyRange.Row + 1
  
'Добавляем новую строку

    Selection.ListObject.ListRows.Add (АктивнаяСтрока)

  
Exit Sub
  
Ошибка:
      MsgBox "Данная строка не принадлежит таблице  !", vbCritical, "Ошибка"
       
End Sub
[/vba]

Но есть несколько но:
1. Строка добавляется выше так как я и хочу, но вот незадача – появляются формулы, которых не должно быть (ячейки выделил выделил желтым цветом).
2. Там, где формулы должны быть их нет (выделил ячейки синим цветом).
3. Строка итогов (серый цвет) – в ней формулы не считают необходимый диапазон ЕСЛИ(ИЛИ(B10=B10);СУММ(H11:H14)), а должно быть ЕСЛИ(ИЛИ(B10=B10);СУММ(H11:H15)) (ячейки выделил (красным цветом).
Появляется синяя стрелка в ячейке Н12 до ячейки Н16.

И самый главный вопрос, как можно в макрос добавить копирование диапазона ячеек (А5:М9) и по нажатию кнопки вставлять его, диапазон, выше активной ячейки, т.е. если курсор стоит в А17, то диапазон нужно вставить выше с сохранением формул, форматов и т.д.

Помогите пожалуйста.

Автор - graffserg
Дата добавления - 10.09.2022 в 21:02
graffserg Дата: Воскресенье, 11.09.2022, 18:15 | Сообщение № 2
Группа: Пользователи
Ранг: Участник
Сообщений: 84
Репутация: 1 ±
Замечаний: 0% ±

2010
Вот, нашёл ещё один код
Код
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 - Понедельник, 12.09.2022, 10:22
 
Ответить
СообщениеВот, нашёл ещё один код
Код
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
Дата добавления - 11.09.2022 в 18:15
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!