Найти в Дзене
kapi.bar

Макрос для Excel.

Пост Капибарина Trailblazer. Капибара, привет! Пост посвящается всем моим любимым офисным жокеям, проводящих большую часть времени в Excel за инвойсами, таблицами с кучей цифр и т.д., где надо много считать и выносить. Для примера возьмём данную таблицу: Предположим, вам нужно сумму ячеек в столбце «Стоимость» вынести в другую программу. При выделении диапазона сумма отображается в нижнем правом углу Excel… …которую нельзя скопировать. Чтобы не вводить эти данные вручную, был написан код для оперативной выгрузки данных. Sub Summation()
Dim selectedRange As Range
Dim visibleCells As Range
Dim cell As Range
Dim sumValue As Double
If TypeName(Selection) <> "Range" Then
MsgBox "a", vbExclamation
Exit Sub
End If
Set selectedRange = Selection
On Error Resume Next
Set visibleCells = selectedRange.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If visibleCells Is Nothing Then
MsgBox "d", vbExclamation
Exit Sub
End If
For Each cell In visibleCells
sumValue = sumValue + cell.Value
Next cell
Copy

Пост Капибарина Trailblazer.

Капибара, привет!

Пост посвящается всем моим любимым офисным жокеям, проводящих большую часть времени в Excel за инвойсами, таблицами с кучей цифр и т.д., где надо много считать и выносить.

Для примера возьмём данную таблицу:

Предположим, вам нужно сумму ячеек в столбце «Стоимость» вынести в другую программу. При выделении диапазона сумма отображается в нижнем правом углу Excel…

-2

…которую нельзя скопировать.

Чтобы не вводить эти данные вручную, был написан код для оперативной выгрузки данных.

Sub Summation()
Dim selectedRange As Range
Dim visibleCells As Range
Dim cell As Range
Dim sumValue As Double
If TypeName(Selection) <> "Range" Then
MsgBox "a", vbExclamation
Exit Sub
End If
Set selectedRange = Selection
On Error Resume Next
Set visibleCells = selectedRange.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If visibleCells Is Nothing Then
MsgBox "d", vbExclamation
Exit Sub
End If
For Each cell In visibleCells
sumValue = sumValue + cell.Value
Next cell
CopyTextToClipboard CStr(sumValue)
End Sub
Sub CopyTextToClipboard(text As String)
Dim DataObj As Object
Set DataObj = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
DataObj.SetText text
DataObj.PutInClipboard
End Sub

Но сначала нужно провести с программой пару манипуляций. Перейдём к списку действий:

1.   Создаём сам макрос и сохраняем в формате .xlsm

Открываем новый файл Excel, зажимаем Alt+F11, верхняя панель – Insert, выбираем Module. Вставляем код, закрываем окно макросов.

Файл сохраняем как «Книга с поддержкой макросов».

-3

Теперь нужно назначить горячую клавишу. Зажимаем Alt+F8, имя макроса – Summation, в «Параметры» установите желаемую связку.

Внимание! Указанная буква будет работать только в своей раскладке клавиатуры (поэтому можно поставить цифру). У меня это «й», поставил для удобства, и ни на какие другие комбинации не ссылается.

Сохраняем. Если где-то будет спрашивать про включение макросов, соглашайтесь.

Готово! Выделяете диапазон, далее Ctrl+й, потом вставляете в любое место из буфера.

-4

НО! Макрос работает только пока открыта книга со вставленным кодом. Далее будет вариант занесения в глобальные шаблоны Excel.

2.   Сохраняем тот же файл, но уже как надстройку в формате .xlam

-5

Затем открываем любую книгу Excel под рукой, наверху Файл, внизу Параметры, Надстройки, Перейти.

-6

Открывается окно, по Обзору ищем только что сохранённую надстройку. Готово! Напротив новой строчки ставим галку – и в путь, можно приступать к работе. Файл надстройки удалять/переносить нельзя: Excel ссылается на его путь.

-7

Работоспособность проверена на всех современных версиях.

Обсудить: https://www.kapi.bar/post/makros-dlya-excel