Оновлюваний багатокористувацький макрос

Я не вмію програмувати, але дуже люблю!
Трохи змінена цитата художника Васі Ложкіна.
Статтею хочу поділитися досвідом підняття багатокористувацької системи на VBA Excel.
На момент прийняття рішення про створення гнучкого додатки, було близько 7 макросів, які працюють за великим обсягам (кілька файлів від 20 тис. рядків до 370 тис. рядків), що важать від 50 кілобайт до 12 мегабайт, кожен з яких був написаний у відповідності зі знаннями існуючими на момент написання. Кожен макрос змінювався, дописувався, виправлявся в частині помилок, а враховуючи, що цими макросами користувалися понад 60 осіб, не всі з яких відстежували зміни, постійно смикали мене показуючи чергову помилку, яку я вже виправив і вислав на всіх. Пояснювати натовпі народу як правильно користуватися макросами, я кинув відразу, так як завжди випаде з ланки 2-3 людини, які візьмуть вже отформатированную таблицю в роботу з макросами і доводи, мовляв я не можу передбачити хто і як змінює таблиці, ці люди не розуміють.
 
Необхідно було зробити один код, а не 60 копій кожного зміни, висланого поштою.
 
Рішення швидко прийшло в голову, а гугл швидко видав мені результати по програмному зміни коду VBA, яка надалі була відкатали на практиці. Отже, текст без картинок не цікавий, ось перша, це структура програми, яка виглядет так:
 
 image
Користувач відкриваючи файл, активуючи подія 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 = "\\0400cmnfscl\usc\ДпВУ\ООСиМПЗ\Общая\Макрос"
    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

Отримавши файли, довантажувати меню.
При завантаженні формується меню, яке поміщається в надбудови
 image
За кодом:
-Для початку видалимо, на випадок якщо буде оновлення:
 

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

 
Результат приблизно ось:
 image
У режимі написання змінив концепцію роботи. Завдання стояло у використанні останньої версії коду при кожному натисканні «виконати макрос». Враховуючи ці обставини, до клієнта будуть завантажуватися певні файли, назвемо їх індексних файлів, тобто постійно присутнім після відкриття файлу модулям, це «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-макрос який матюкався так:
 image
Покуривши мануали 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=\\0400cmnfscl05fs\usc\ДпВУ\ООСиМПЗ\ГУОпОС\ФИО\base\base" & 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 на відпрацювання залежно від необхідного результату.
Як то так.

Джерело: Хабрахабр

0 коментарів

Тільки зареєстровані та авторизовані користувачі можуть залишати коментарі.