Sniper1
Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Цитата: Sniper1
Код:
Private Sub Workbook_Open()
With Application
.OnKey "^+{Up}", "prcRowUp"
.OnKey "^+{Down}", "prcRowDown"
End With
End Sub
Sub prcRowUp()
Dim oRow As Range, oTable As Range, oCell As Range
Set oTable = ActiveSheet.Range(Cells(4, 1), Cells(16, 9))
Set oCell = ActiveCell
With Application
.EnableEvents = False
.ScreenUpdating = False
With oTable
If Not Intersect(oCell, oTable) Is Nothing Then
Set oRow = Intersect(oTable, oCell.EntireRow)
With oRow
If .EntireRow.Row > oTable.Rows(1).EntireRow.Row Then
.Cut
.Offset(-1).Insert 'Shift:=xlDown
.Offset(1).Insert Shift:=xlDown
.Copy
.Offset(1).PasteSpecial xlPasteFormats
.Offset(2).Copy
.PasteSpecial xlPasteFormats
.Offset(1).Copy
.Offset(2).PasteSpecial xlPasteFormats
.Offset(1).Delete Shift:=xlUp
End If
End With
End If
End With
oCell.Select
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
Sub prcRowDown()
Dim oRow As Range, oTable As Range, oCell As Range
Set oTable = ActiveSheet.Range(Cells(4, 1), Cells(16, 9))
Set oCell = ActiveCell
With Application
.EnableEvents = False
.ScreenUpdating = False
With oTable
If Not Intersect(oCell, oTable) Is Nothing Then
Set oRow = Intersect(oTable, oCell.EntireRow)
With oRow
If .EntireRow.Row < oTable.Rows(13).EntireRow.Row Then
.Cut
.Offset(2).Insert 'Shift:=xlDown
.Insert Shift:=xlDown
.Copy
.Offset(-1).PasteSpecial xlPasteFormats
.Offset(-2).Copy
.PasteSpecial xlPasteFormats
.Offset(-1).Copy
.Offset(-2).PasteSpecial xlPasteFormats
.Offset(-1).Delete Shift:=xlUp
End If
End With
End If
End With
oCell.Select
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
Добавлено:
Этот код исключительно под Ваши таблицы. Причём в том виде, в котором Вы их представили, включая кол-во строк. В "новую строку" копируется всё, кроме форматов - как Вы и хотели. |
Огромное спасибо Ув. vlth но чуть чуть не подходит ваш вариант. таблица не статическая, строки будут добавляться иногда или даже удаляться. ещё раз благодарю за проделанную не маленькую работу.
Цитата:| Одна голова хорошо, а две лучше. А три, это уже Змей горыныч |
А тем более три головы как ваши с vlth это вообще атас.
Цитата: Цитата:
формулы у меня тока в столбе "H". Подумайте на досуге как решить и эту задачу.
Вот вам полное решение, учитывая именно столбец "H", а также учитывая тот факт, что в столбце "H" по строкам одинаковые формулы.
Код: |
Идеальный вариант просто не к чему придраться.
Хе, только начал радоваться а тут заметил кое что, что не отрабатывается. Короче в столбе "A" у меня там гиперссылки будут на фотографии клиентов, каждая строка это клиент. так вот надо что б гиперссылки бежали за своими клиентами то есть за строками. Прикладываю файл для наглядности. |
смотрите 
и это теперь во всех книжках. как это теперь убрать? вот что значит заставь дурака молится он и лоб расшибет 
