Полезные Excel Макросы
Предисловие
Вы можете свободно применять следующие примеры макросов в ваших Excel-приложениях. Эти макросы представляют простые процедуры и полезные подсказки, которые вы можете использовать, чтобы создать интерактивные Excel-приложения для чтения и записи данных в DataHub.
Познакомьтесь с возможностями подключения DataHub к Excel
Введение
Эти Excel Макросы основаны на таблице данных, состоящей из 100 строк и 40 столбцов (начиная с ячейки А1) и расположенной в Лист1 (Sheet1) рабочей таблицы. Мы постарались создать унифицированные макросы, которые вы сможете легко настроить под свои нужды.
Макросы, которые помогут настроить Excel для чтения данных из DataHub (используется DDEAdvise)
1. Макрос включает массивы данных из DataHub в таблицу значений Excel, по одному массиву на строку.
Зачастую большие наборы данных более удобно передавать в виде массива, поскольку это существенно снижает требования к пропускной способности и увеличивает скорость передачи. Этот макрос настраивает циклы DDEAdvise от DataHub к Excel так, что каждая строка таблицы связана со значением массива в DataHub. Как правило, вам нужно запустить этот макрос только один раз — при настройке электронной таблицы.
Каждое значение данных, представляющее строку данных, поименовано, как "array0001", "array0002" и т.д. --------- Add to Sheet 1 Macro Code ------------- Sub register_arrays() Dim pname As String For i = 1 To 100 pname = Format(i, "0000") pname = "=datahub|default!array" & pname Worksheets("Sheet1").Range(Cells(i, 1), Cells(i, 40)).FormulaArray = pname Next i End Sub ---------------------------------------------------
2. Включает отдельные значения данных из DataHub в таблицу значений, по одному значению на ячейку.
Этот макрос настраивает циклы DDEAdvise от DataHub к Excel так, что каждая ячейка таблицы связана со значением метки в DataHub. Как правило, вам нужно запустить этот макрос только один раз — при настройке электронной таблицы.
Каждое значение данных метки поименовано, как "point0001", "point0002" и т.д. --------- Add to Sheet 1 Macro Code ------------- Sub register_points() Dim pname As String For i = 1 To 100 For j = 1 To 40 pname = Format((i - 1) * 40 + j, "0000") pname = "=datahub|default!point" & pname Worksheets("Sheet1").Cells(i, j).Formula = pname Next j Next i End Sub ---------------------------------------------------
Макросы для записи данных из Excel – Запись инициируется по запросу пользователя (используется DDEPoke)
Следующие макросы полезны для записи данных из Excel по запросу, другими словами, пользователь решает, когда записывать данные, и инициирует запись путем запуска одного из этих макросов (обычно щелчком по определенной кнопке).
3. Передает массив данных позициям в DataHub, по одному массиву на строку.
Этот макрос будет запускаться каждый раз, когда вы хотите записать данные из таблицы Excel в DataHub. Этот макрос будет записывать каждую строку таблицы как значение массива в DataHub. Макрос передает все строки таблицы, одну за другой.
Каждое значение данных, представляющее строку данных, поименовано, как "array0001", "array0002" и т.д. --------- Add to Sheet 1 Macro Code ------------- Sub transmit_arrays() Dim chan As Integer Dim pname As String chan = DDEInitiate("datahub", "default") For i = 1 To 100 pname = Format(i, "0000") pname = "array" & pname DDEPoke chan, pname, Worksheets("Sheet1").Range(Cells(i, 1), Cells(i, 40)) Next i DDETerminate (chan) End Sub ---------------------------------------------------
4. Передает отдельные значения данных позициям в DataHub, по одному значению на ячейку.
Этот макрос будет запускаться каждый раз, когда вы хотите записать данные из таблицы Excel в DataHub. Этот макрос будет записывать каждую ячейку таблицы в отдельную позицию DataHub. Макрос передает все ячейки таблицы, одну за другой.
Каждое значение данных метки поименовано, как "point0001", "point0002" и т.д. --------- Add to Sheet 1 Macro Code ------------- Sub transmit_points() Dim chan As Integer Dim pname As String chan = DDEInitiate("datahub", "default") For i = 1 To 100 For j = 1 To 40 pname = Format((i - 1) * 40 + j, "0000") pname = "point" & pname DDEPoke chan, pname, Worksheets("Sheet1").Cells(i, j) Next j Next i DDETerminate (chan) End Sub ---------------------------------------------------
Макросы для записи данных из Excel – Автоматическая запись при изменении значения (используется DDEPoke)
Следующие макросы могут быть полезны для автоматической передачи данных из Excel в DataHub.
5. Каждый раз, когда пользователь вводит новое значение, проверяет, поименована ли ячейка. Если да, новое значение передается позиции DataHub с тем же именем.
Имя подпрограммы "Worksheet_Change" является специальным - Excel вызывает ее каждый раз, когда в таблице (Worksheet) появляется изменение, будь то пользовательский ввод или пересчет (но кроме изменений, вызванных сообщением DDE, см. №7 ниже).
--------- Add to Sheet 1 Macro Code ------------- Sub Worksheet_Change(ByVal Target As Range) Dim rname As String Dim channel As Variant On Error Resume Next rname = Target.name.name If Not rname = "" Then channel = DDEInitiate("datahub", "default") DDEPoke channel, rname, Target DDETerminate (channel) End If End Sub ---------------------------------------------------
6. Определяет, когда ячейка из диапазона, поименованного определенным образом, изменилась посредством пользовательского ввода, и передает содержимое диапазона DataHub.
Этот макрос полезен, поскольку нет необходимости настраивать каждую ячейку, значение которой необходимо записывать в DataHub. Если изменившаяся ячейка из определенного диапазона, все значения данного диапазона автоматически записываются в DataHub.
Эта программа выявляет диапазон, включающий изменения, и если диапазон подходит под один из заранее определенных, отправляет диапазон DataHub. Функция извлекает имя диапазона ячеек, пересекающегося с заданным диапазоном. Если больше одного диапазона в таблице пересекаются с заданным диапазоном, возвращается первый. -------- Add to Workbook Macro Code ------------- Function NameOfParentRange(Rng As Range) As String Dim Nm As Name For Each Nm In ThisWorkbook.Names If Rng.Parent.Name = Nm.RefersToRange.Parent.Name Then If Not Application.Intersect(Rng, Nm.RefersToRange) Is Nothing Then NameOfParentRange = Nm.Name Exit Function End If End If Next Nm NameOfParentRange = "" End Function --------- Add to Sheet 1 Macro Code ------------- Sub Worksheet_Change(ByVal r As Range) Dim pname As String Dim chan As Integer pname = ThisWorkbook.NameOfParentRange(r) If Not pname = "" Then On Error Resume Next chan = DDEInitiate("datahub", "default") DDEPoke chan, pname, Worksheets("Sheet1").Range(pname) DDETerminate (chan) End If End Sub ---------------------------------------------------
Другие полезные Excel Макросы
7. Инициирует вызов макроса при получении сообщения DDE для определенной позиции.
Следующие два макроса иллюстрируют, как настроить связь так, чтобы макрос запускался каждый раз, когда значение ячейки обновляется сообщением DDE. В примере ниже мы исходим из того, что в ячейку внесено обновленное значение из DataHub. Мы определяем связь так, чтобы макрос запускался при каждом обновлении значения метки.
Допустим, что point0001 обновляется посредством ссылки DDEAdvise из DataHub. Макрос set_link создает связь между позицией DataHub point0001 и макросом link_updated. Макрос link_updated() просто увеличивает значение в ячейке А1 на 1. Вам нужно только единожды запустить макрос set_link (возможно, когда лист загружен) для установления связи. Всякий раз, когда ячейка, содержащая point0001, обновляется DataHub, макрос link_updated будет запускаться и значение в Cell (1,1) будет увеличено на 1. --------- Add to Sheet 1 Macro Code ------------- Sub link_updated() Cells(1, 1) = Cells(1, 1) + 1 End Sub -------- Run once to establish link ------------- Sub set_link() ThisWorkbook.SetLinkOnData "datahub|default!'point0001'", "Sheet1.link_updated" End Sub ---------------------------------------------------
Читайте также
Узнайте больше о Excel connections to/from the DataHub.
Источник: http://cogentdatahub.com/Features/Helpful_Excel_Macros.html