Здравствуйте, подскажите, пожалуйста решение. Как скопировать в буфер сумму выделенных ячеек. Можно сделать так что бы сумма автоматически копировалась в буфер после выделения?
Здравствуйте, подскажите, пожалуйста решение. Как скопировать в буфер сумму выделенных ячеек. Можно сделать так что бы сумма автоматически копировалась в буфер после выделения?noobik
noobik, можно запомнить сумму в отдельую переменную:[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) ' Сюда пишем диапазон, в котором выделяем ячейки для подсчета суммы If Intersect(Target, Range("a1:f20")) Is Nothing Then Exit Sub summ = 0 For Each cell In Selection If IsNumeric(cell.Value) Then summ = summ + cell.Value Next cell ' 'Если очень хочется именно в буфер, можно вставить значение на лист и скопировать ячейку ' [a1000] = summ ' [a1000].Copy End Sub
[/vba]
noobik, можно запомнить сумму в отдельую переменную:[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) ' Сюда пишем диапазон, в котором выделяем ячейки для подсчета суммы If Intersect(Target, Range("a1:f20")) Is Nothing Then Exit Sub summ = 0 For Each cell In Selection If IsNumeric(cell.Value) Then summ = summ + cell.Value Next cell ' 'Если очень хочется именно в буфер, можно вставить значение на лист и скопировать ячейку ' [a1000] = summ ' [a1000].Copy End Sub
Sub sum18() Dim svh As DataObject Set svh = New DataObject sums = 0 For Each cell In Selection If IsNumeric(cell) Then sums = sums + cell End If Next svh.SetText sums svh.PutInClipboard End Sub
Sub sum18() Dim svh As DataObject Set svh = New DataObject sums = 0 For Each cell In Selection If IsNumeric(cell) Then sums = sums + cell End If Next svh.SetText sums svh.PutInClipboard End Sub
Марин, а зачем в цикле? Есть же функция листа [vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Set Target = Intersect(Target, Range("a1:p20")) ' чтобы исключить "лишние" ячейки, если выделенный диапазон шире контролируемого If Target Is Nothing Then Exit Sub With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") .SetText WorksheetFunction.Sum(Target) .PutInClipboard End With End Sub
[/vba] [p.s.]Worksheet_SelectionChange - это первое, что приходит в голову, но ИМХО, вычисление при каждом выделении - это нерациональное использование ресурсов... Лучше добавить пункт в меню по правому клику и пользоваться им при необходимости.[/p.s.]
UPD. Во вложенном файле реализация доп. пункта меню "Копировать сумму выделенных ячеек" (по правому клику на выделенных ячейках) Можно поместить этот код в модуль книги в личную книгу макросов.
[vba]
Код
Private Sub Workbook_Open() With Application.CommandBars("Cell").Controls.Add(msoControlButton, 19, , 3, True) .Caption = "Копировать сумму выделенных ячеек" .OnAction = "ЭтаКнига.SumToClipboard" End With End Sub
Private Sub SumToClipboard() With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") .SetText WorksheetFunction.Sum(Selection) .PutInClipboard End With End Sub
[/vba]
Марин, а зачем в цикле? Есть же функция листа [vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Set Target = Intersect(Target, Range("a1:p20")) ' чтобы исключить "лишние" ячейки, если выделенный диапазон шире контролируемого If Target Is Nothing Then Exit Sub With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") .SetText WorksheetFunction.Sum(Target) .PutInClipboard End With End Sub
[/vba] [p.s.]Worksheet_SelectionChange - это первое, что приходит в голову, но ИМХО, вычисление при каждом выделении - это нерациональное использование ресурсов... Лучше добавить пункт в меню по правому клику и пользоваться им при необходимости.[/p.s.]
UPD. Во вложенном файле реализация доп. пункта меню "Копировать сумму выделенных ячеек" (по правому клику на выделенных ячейках) Можно поместить этот код в модуль книги в личную книгу макросов.
[vba]
Код
Private Sub Workbook_Open() With Application.CommandBars("Cell").Controls.Add(msoControlButton, 19, , 3, True) .Caption = "Копировать сумму выделенных ячеек" .OnAction = "ЭтаКнига.SumToClipboard" End With End Sub
Private Sub SumToClipboard() With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") .SetText WorksheetFunction.Sum(Selection) .PutInClipboard End With End Sub
Пытаюсь использовать это решение на Office для Mac (v15.15)
Открыл ваш файл, нажал "Включить макросы", но в контекстном меню нет пункта "Копировать сумму выделенных ячеек" [moder]Читаем правила форума, создаем свою тему, эта тема закрыта![/moder]
KSV, добрый день.
Пытаюсь использовать это решение на Office для Mac (v15.15)
Открыл ваш файл, нажал "Включить макросы", но в контекстном меню нет пункта "Копировать сумму выделенных ячеек" [moder]Читаем правила форума, создаем свою тему, эта тема закрыта![/moder]palamart
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
