Я не умею программировать, но очень люблю!
Немного измененная цитата художника Васи Ложкина.
Статьей хочу поделиться опытом поднятия многопользовательской системы на VBA Excel.
На момент принятия решения о создании гибкого приложения, было порядка 7 макросов, работающих по большим объемам (несколько файлов от 20 тыс. строк до 370 тыс. строк), весящих от 50 килобайт до 12 мегабайт, каждый из которых был написан в соответствии со знаниями существующими на момент написания. Каждый макрос изменялся, дописывался, исправлялся в части ошибок, а учитывая, что этими макросами пользовались более 60 человек, не все из которых отслеживали изменения, постоянно дергали меня показывая очередную ошибку, которую я уже исправил и выслал на всех. Объяснять толпе народу как правильно пользоваться макросами, я бросил сразу, так как всегда выпадет из звена 2-3 человека, которые возьмут уже отформатированную таблицу в работу с макросами и доводы, мол я не могу предугадать кто и как изменяет таблицы, эти люди не понимают.
Необходимо было сделать один код, а не 60 копий каждого изменения, высланного по почте.
Решение быстро пришло в голову, а гугл быстро выдал мне результаты по программному изменению кода VBA, которая в последствии была откатана на практике. Итак, текст без картинок не интересен, вот первая, это структура приложения, которая выглядет так:
Пользователь открывая файл, активируя событие excel «открытие книги» выполняет процедуру, находящуюся в файле «клиенте». Процедура формирует меню, читая файлы на сети. Нажимая на кнопку нужного макроса, выполняется действие по созданию модуля в клиенте, из файла находящегося на сети, выполняет действия и уничтожает процедуру внутри себя.
Что мы получаем:
— файл для любого макроса всегда один.
— нажимая на выполнение какого либо макроса, пользователь будет всегда пользоваться самым последним кодом, что упрощает поддержку макросов.
— возможность писать лог файл по ошибкам, с указанием пользователя, на случай необходимости избить того кто все испортил.
Далее будет много копипаста по коду, измененного под мои задачи, я бы с удовольствием указал авторов, но честно не знаю, много кода брал с буржуйских ресурсов, что то с российских, что то придумано мною, все это копилось в течении полугода минимум, так что заранее большое сорри перед первоисточниками, если чего, пишите, удалю.
Итак, практическая часть.
Вешаем событие на открытие книги:
Private Sub Workbook_Open()
create_module_for_file
End Sub
Код не хитрый, концепция одна, дать пинок для дальнейших действий
Процедура create_module_for_file:
filemod = OpenFileModule("menu")
cl_d.create_module ("menu")
cl_d.write_sub_for_module_action filemod, "menu"
filemod = OpenFileModule("list_action")
cl_d.create_module ("list_action")
cl_d.write_sub_for_module_action filemod, "list_action"
Три строки три действия, в начале нам необходимо подобрать файл с модулем. За это отвечает следующая функция:
Function OpenFileModule(namemodule)
Set FSO = CreateObject("Scripting.FileSystemObject")
filepath = "400cmnfscluscДпВУООСиМПЗОбщаяМакрос"
mSearch = ".txt"
OpenFileModule = FSO.GetFile(filepath & "" & namemodule & mSearch)
End Function
Далее создаем модуль:
Function create_module(name_module)
' создаем новый модуль макроса и подпрограмм
ThisWorkbook.VBProject.VBComponents.Add vbext_ct_StdModule
' определяем индекс созданного модуля
k = ThisWorkbook.VBProject.VBComponents.Count
' даем свое имя модуля
ThisWorkbook.VBProject.VBComponents.Item(k).Name = name_module
End Function
И пишем в модуль код из файла
Function write_sub_for_module_action(filepath, filename)
Open filepath For Input As #1
s = ""
Do Until EOF(1)
Line Input #1, Data
s = s & Data & z & z
Loop
Set vbComp = ThisWorkbook.VBProject.VBComponents(filename)
With vbComp.CodeModule
.InsertLines .CountOfLines + 1, s
End With
Set vbComp = Nothing
Close #1
End Function
Получив файлы, подгружаем меню.
При загрузке формируется меню, которое помещается в надстройки
По коду:
-для начала удалим, на случай если будет обновление:
Application.CommandBars(1).Controls("MTS_K").Delete
- создаем панель
<source lang=«VBScript»>
‘ вычисляем куда положить, позицию, в случае если уже есть открытые надстройки
MenuPos = Application.CommandBars(1).FindControl(ID:=30010).Index + 1
‘ добавляем панель
Set Menu = Application.CommandBars(1).Controls.Add(Type:=msoControlPopup, before:=MenuPos, temporary:=True)
‘ задаем имя для панели
Menu.Caption = "MTS_K"
Панель создали, теперь создаем непосредственно меню, которое будет создавать кнопки непосредственно по каждому файлу с макросами.
‘ создаем кнопку для подменю
Set Menuname = Menu.Controls.Add(Type:=msoControlPopup)
‘ задаем имя для кнопки
Menuname.Caption = "Перевод YES->NO"
После того как меню создано, добавляются кнопки. Меню строилось по принципу файл -> одна кнопка. В свою очередь по одному файлу с макросом может быть несколько процедур, которые необходимо вызывать, вот в под меню их и суем. Данный код создает 3 кнопки:
Set SubItem = MenuItem.Controls.Add(Type:=msoControlButton) ‘ добавляет кнопку
SubItem.Caption = "Картотека к виду" ‘ название, которое будет отображаться в меню
SubItem.FaceId = "801" ‘ здесь указываем айди картинки, для отображения у кнопки
SubItem.OnAction = "action11a" ‘ здесь название вызываемой процедуры
SubItem.Enabled = True ‘ отображаем или нет
Set SubItem = MenuItem.Controls.Add(Type:=msoControlButton)
SubItem.Caption = "Сформировать файлы"
SubItem.FaceId = "1038"
SubItem.OnAction = " action12a"
SubItem.Enabled = True
Set SubItem = MenuItem.Controls.Add(Type:=msoControlButton)
SubItem.Caption = "Сформировать файлы для модернизации"
SubItem.FaceId = "1038"
SubItem.OnAction = " action13a"
SubItem.Enabled = True
Результат примерно вот:
В режиме написания изменил концепцию работы. Задача стояла в использовании последней версии кода при каждом нажатии «выполнить макрос». Учитывая эти обстоятельства, к клиенту будут загружаться определенные файлы, назовем их индексным файлам, то есть постоянно присутствующим после открытия файла модулям, это «menu» и «list action», а непосредственно файлы макросов будут подгружаться по нажатию кнопки. В чем их смысл: файл меню формирует меню :)
Set MenuItem = PLEXMenu.Controls.Add(Type:=msoControlPopup)
MenuItem.Caption = "Работа по картотеке"
Set SubItem = MenuItem.Controls.Add(Type:=msoControlButton)
SubItem.Caption = "Картотека к виду"
SubItem.FaceId = "801"
SubItem.OnAction = "action11"
SubItem.Enabled = True
В меню мы видим событие, ссылающееся на процедуру «action1…x», которая сидит во втором файле «list_action». Посмотрим на его содержимое
Sub action11()
Set cl_d = New Edit_module
On Error Resume Next
cl_d.delete_modul_full ("action_yes_no")
filemod = OpenFileModule("action_yes_no")
cl_d.create_module ("action_yes_no")
cl_d.write_sub_for_module_action filemod, "action_yes_no"
kart_view
End Sub
Что мы делаем, во-первых нам необходимо удалить модуль для того что бы его заного загрузить и использовать, мало ли код изменен. Далее мы открываем файл, создаем модуль и пишем в него код из файла.
После этих манипуляций нам необходимо вызвать процедуру, выполняющую манипуляции, которые подразумевались нажатием на кнопку выполнения процедуры.
Здесь интересно)
Если мы укажем имя процедуры, которая находится непосредственно в коде выше, у нас процедура action11 ругнется на то что не может найти процедуру «kart_view», и правильно, ведь по факту ее на момент нажатия кнопки исполнения процедуры нет, на этот случай использован лайфхак, создается функция, которая в свою очередь вызывает эту процедуру, код вот:
Sub action11()
Set cl_d = New Edit_module
On Error Resume Next
cl_d.delete_modul_full ("action_yes_no")
filemod = OpenFileModule("action_yes_no")
cl_d.create_module ("action_yes_no")
cl_d.write_sub_for_module_action filemod, "action_yes_no"
action11a
End Sub
Function action11a()
kart_view
End Function
То есть на момент вызова «kart_view» из «action11a», данная процедура уже будет загружена в модуль, vba подвоха не видит.
Получаемый итог: жмем на кнопку, загружается код в модуль, выполняется. В случае повторного выполнения модуль удаляется, грузится заново, выполняется. При закрытии файла книга отчищается от всего, для того что бы не занимать место и спокойно лежать до следующего открытия.
Еще пару слов по обработке больших файлов, думаю будет интересно. Как говорилось, файлы используются большого объема, более 300 тыс.строк, из которых необходимо выбрать, как правило, тыс. 10-30 и работать с ними.
Если бы меня с пол года назад спросили как сделать выборку, я бы не ведая сказал бы цикл с условием. В последствии было перепробовано много способов, опишу каждый, так, для инфо, кроме тех что можно реализовать стандартными функциями excel.
Исходные данные: есть таблица 300 тыс строк, известно 10 тыс значений, которые нам нужны.
1) Вначале я попытался сделать выборку циклом
tab1 = таблица один
tab2 = таблица один
col_tab1 = tab1.Cells(Rows.Count, 1).End(xlUp).Row ‘количество строк первой таблицы (10 тыс)
col_tab2 = tab2.Cells(Rows.Count, 1).End(xlUp).Row ‘количество строк второй таблицы (300 тыс)
for i = 1 to col_tab1
for ii = 1 to col_tab2
if tab1.cells(ii,1) = tab2.cells(i,1) then
действия
exit for
end if
next ii
next i
Что получаем, если не завершать цикл, получается что нам 10000 раз необходимо перебрать 300000 строк для поиска результата. Отрабатыва vba будет примерно 500 строк в секунду, итого
3000000000/500 = 6000000 секунд, (100000 минут или 1666,66 часов или 69 дней или 9 недель или …)
А результат как правило нужен здесь и сейчас, ну или через пару минут максимум, так что сразу нет.
2) Второй используемый мною способ – работа с mysql сервером
Для работы с mysql сервером, который уже был, для другого проекта, был необходим драйвер mysql ODBC, их мне было известно 2, версия 3.51, и версия 5.1 Выбор пал на 3.51, так как второй, по обсуждениям его работы на форумах, не очень хорошо работал с кодировками, а базу хотелось в utf8
Драйвер мне поставили, и первая кочка, на которой я споткнулся – права доступа
То есть нужна учетная запись для подключения из вне, в нашем случае это будет vba-макрос который матерился так:
Покурив мануалы sql, нашел это
CREATE USER '%'@'user' IDENTIFIED BY PASSWORD 'mtspass';
GRANT SELECT ON *.* TO '%'@'user';
То есть, по запросу выше, создается учетная запись для любого пользователя с рут правами.
Естественно рут прав мне никто не дал и проект использующий mysql сервер для хранения данных, был «заморожен» так как в перспективе нужно было писать в базу данные, у меня было только чтение.
Для оценки эффективности: один и тот же макрос используя переборы с помощью циклов работал 59 секунд, с sql удалось сделать все то же самое за 3,5-4 секунды, то есть реально удалось ускориться более чем в 10 раз.
По коду хорошая статья вот здесь: egregors.blogspot.ru/2013/05/mysql-vba-excel-mysql.html
3) Продолжая курить тему sql, начал работу по работе с access.
Код получается адовый, но рабочий.
Set cN = New ADODB.Connection ‘переменная подключения
cN.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=400cmnfscl05fsuscДпВУООСиМПЗГУОпОСФИОbasebase" & Environ("USERNAME") & ".mdb; Jet OLEDB:Database;" ‘ подключаемя к файлу базы
‘ соберем нужные активы для поиска
for i = 1 to col_tab1
nabor_act = nabor_act & “’,’” & tab1.cells(i,1)
next i
Set RS = New ADODB.Recordset ‘ переменная в которую будет занесен результат
RS.Open "SELECT * FROM kartoteka WHERE nom_act LIKE ‘” & right(nabor_act, len(nabor_act)-3) & ”’ ;", cN, adOpenStatic, adLockOptimistic
o = 2
Do While Not RS.EOF
ter.Cells(o, 1) = "РСБУ" & Right$(RS.Fields(1).Value, 6)
ter.Cells(o, 2) = RS.Fields(2).Value
ter.Cells(o, 3) = "КОРРЕКТ"
ter.Cells(o, 4) = RS.Fields(6).Value
ter.Cells(o, 5) = ""
o = o + 1
RS.MoveNext
Loop
cN.Close
Set cN = Nothing
Данный способ работает медленнее чем mysql, почему то, но вполне приемлем для использования. Но не мне…
Отказался я от него в первый же раз, когда нужна была система при котором пользователь в определенной папке создает базу и пишет туда 2 таблицы по 300 тыс.строк, для их сравнения и вычисления. При тестах у меня получилась база размером около 600 метров, учитывая что в перспективе этим макросом одновременно может воспользоваться 50 человек, получается папка размером в примерно 25-30 гигов, за которую меня админы четвертовали бы сразу.
4) Собственно способ на котором я остановился. Да, работает медленнее второго и третьего способа, но данные недостатки компенсируются функциональностью. Sql запрос по книге
Set cn = New ADODB.Connection ' экземпляр класса коннекта
cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ActiveWorkbook.path & "" & ActiveWorkbook.Name & ";Extended Properties=Excel 12.0;" ' подключаемся к файлу
cn.ConnectionTimeout = 40
cn.Open
‘ соберем нужные активы для поиска
for i = 1 to col_tab1
nabor_act = nabor_act & “’,’” & tab1.cells(i,1)
next i
sql = "SELECT * FROM [res$] WHERE [Номер актива] ‘” & right(nabor_act, len(nabor_act)-3) & ”’ "
Dim rs As New ADODB.Recordset
Set rs = New ADODB.Recordset ' экземпляр класса записи
rs.ActiveConnection = cn ' говорим откуда идет соединение
rs.LockType = adLockOptimistic ' это значение позволяет выиграть в производительности за счет проигрыша в надежности обеспечения целостности данных. Запись на источнике блокируется только на время выполнения метода Update(). Остальные пользователи могут одновременно с вами читать и изменять данные на источнике.
rs.CursorLocation = adUseClient ' курсор на стороне клиента
rs.source = sql ' запрос
rs.Open
rs.MoveFirst ' начать с первой записи
rew = ""
Do Until rs.EOF ' перебираем вперед
rew = rew & "','" & rs.Fields(0).Value
rs.MoveNext ' переход к следующей строке
Loop
rs.Close
cn.Close
Вот… Если брать условия примера, на вскидку где то секунд 10 соберется строка для запроса, секунд 25 повисит запрос с выборкой, секунд 10 на отработку в зависимости от необходимого результата.
Как то так.
Автор: SarumSv
