Добрый всем день! Помогите сделать следующее, скорее всего макросом. При добавлении строки в умной таблице, итоговая строка (желтая) должна также опускаться, а при удалении данных в любой строке из столбца C эта строка должна исчезнуть, а нижняя часть таблицы вместе с итоговой строкой - подниматься.
Добрый всем день! Помогите сделать следующее, скорее всего макросом. При добавлении строки в умной таблице, итоговая строка (желтая) должна также опускаться, а при удалении данных в любой строке из столбца C эта строка должна исчезнуть, а нижняя часть таблицы вместе с итоговой строкой - подниматься.zsm
Здравствуйте. Включаем строку итогов, в модуль ЭтаКнига пишем [vba]
Код
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) On Error Resume Next With Target.ListObject If Not Intersect(.TotalsRowRange, Target) Is Nothing Then Application.EnableEvents = 0 If Err = 0 Then .ListRows.Add: Cancel = True Application.EnableEvents = 1 End If End With End Sub
[/vba] в модуль Лист1 [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim r As Range If Intersect(Target, [Таблица3[название]]) Is Nothing Then Exit Sub With [Таблица3].ListObject With .ListColumns("название").DataBodyRange Set r = IIf(.Cells.Count = 1, .Resize(2), .Cells) End With Intersect(r.SpecialCells(4), .Range).Delete xlUp Set r = Nothing End With End Sub
[/vba] Жмакаем двойным кликом по строке итогов
Здравствуйте. Включаем строку итогов, в модуль ЭтаКнига пишем [vba]
Код
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) On Error Resume Next With Target.ListObject If Not Intersect(.TotalsRowRange, Target) Is Nothing Then Application.EnableEvents = 0 If Err = 0 Then .ListRows.Add: Cancel = True Application.EnableEvents = 1 End If End With End Sub
[/vba] в модуль Лист1 [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim r As Range If Intersect(Target, [Таблица3[название]]) Is Nothing Then Exit Sub With [Таблица3].ListObject With .ListColumns("название").DataBodyRange Set r = IIf(.Cells.Count = 1, .Resize(2), .Cells) End With Intersect(r.SpecialCells(4), .Range).Delete xlUp Set r = Nothing End With End Sub
[/vba] Жмакаем двойным кликом по строке итоговkrosav4ig
Спасибо! Я наверно сильно назойливый, но при вводе в ячейку Cx выделяется массив С:С при переходе и вводе, удалении в других ячейках также выделяется этот массив, что очень неудобно. Может подточите макрос. И можно ли сделать активацию ячейки С (для добавления строки) в строке итоги не двойным, а одинарным кликом?
Спасибо! Я наверно сильно назойливый, но при вводе в ячейку Cx выделяется массив С:С при переходе и вводе, удалении в других ячейках также выделяется этот массив, что очень неудобно. Может подточите макрос. И можно ли сделать активацию ячейки С (для добавления строки) в строке итоги не двойным, а одинарным кликом?zsm
И можно ли сделать активацию ячейки С (для добавления строки) в строке итоги не двойным, а одинарным кликом?
в модуль ЭтаКнига [vba]
Код
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) On Error Resume Next With Target.ListObject If Not Intersect(.TotalsRowRange, Target) Is Nothing And Target.Count = 1 Then Application.EnableEvents = 0 If Err = 0 Then: .ListRows.Add: Target(0).Select Application.EnableEvents = 1 End If End With End Sub
И можно ли сделать активацию ячейки С (для добавления строки) в строке итоги не двойным, а одинарным кликом?
в модуль ЭтаКнига [vba]
Код
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) On Error Resume Next With Target.ListObject If Not Intersect(.TotalsRowRange, Target) Is Nothing And Target.Count = 1 Then Application.EnableEvents = 0 If Err = 0 Then: .ListRows.Add: Target(0).Select Application.EnableEvents = 1 End If End With End Sub