Всем привет! Появилось немного свободного времени в пятницу и решил я запилить что-нибудь годное для Excel. Ну что бы не просто, а что нибудь полезное... После некоторых размышлений, стало ясно, что годного и полезного и так целый Гугл и Яндекс, а в голову приходит только посредственное, и вредное (коего еще больше в гугле), что как бы намекает на то, что в пятницу вечером можно заняться и другим...Но, взяв себя в руки, накатив чаю, было решено на C API залить какую-либо функцию в xll. Тыкнув пальцем в открытый Excel в 99% случаев офисных документов попадаем в ВПР() (VLOOKUP()), не стал исключением и мой палец. Что в итоге: По самописному VLOOKUP2() (надстройку прилагаю, функция VLOOKUP2() лежит в категории функций (BedvitXLL)). Из наблюдений: 1.Разработчика ВПР() свое дело знали хорошо, см. результаты теста. 2.Оптимизаций не производилось, перебором в лоб и на амбразуры (хотя и по байтам, что несколько быстрее) 2.Быстрее работает с явно указанным диапазоном, чем со всем столбцом(строкой)-в разы 3.Ест любого размера текст (сколько влезет в ячейку) 4.Ищет соответствие по позиции, поэтому можно сравнивать столбцы, строки, прямоугольные диапазоны.
Оборудование: Win7x64+Excel2016x64 Тест - 1) -1004 строк по 32726 символов, -все строки одинаковой длины в поиске и в массиве -нужная строка в конце массива -последняя строка отличается последним знаком
=ВПР($C1;$A$1:$B$1004;2;0) - не работает (строка до 255 символов включительно) =ИНДЕКС($B$1:$B$1004;ПОИСКПОЗ($C1;$A$1:$A$1004;0)) - не работает (строка до 255 символов включительно) =ПРОСМОТР(2;1/($A:$A=$C1);$B:$B) - 46 сек. =VLOOKUP2($A:$A;$B:$B;$C1) - 60,48 сек =ПРОСМОТР(2;1/($A$1:$A$1004=$C1);$B$1:$B$1004) - 15,87 сек =VLOOKUP2($A$1:$A$1004;$B$1:$B$1004;$C1)-16,68 сек.
Тест - 2) -10004 строк по 255 символов, -все строки одинаковой длины в поиске и в массиве -нужная строка в конце массива -последняя строка отличается последним знаком
Итого работа по скорости соизмерима с ПРОСМОТР(...), профита без оптимизаций нет.
Посему предлагаю рассмотреть, что нужно в действительности, что работало бы быстро и реализовывалось через функцию рабочего листа Excel. Возможно получится сделать что-то действительно полезное
Можно использовать эти функции и в VBA через Application.Run. Функции могут возвращать массив. К примеру VLOOKUP2:
Код
Sub Test3() ' ТЕСТ EXE
Dim t, arr(10000, 2) As Long, arr2(10000, 2) As String, x
t = Timer
arr(9999, 2) = 50
arr2(9999, 2) = "Все работает!"
Debug.Print Application.Run("VLOOKUP2", arr, arr2, 50)
'ищем значение 50 в 9999 позиции третьего (у учетом нулевого) измерения, выводим соответствующие данные из второго массива
Debug.Print "Time = " & Timer - t
End Sub
У кого есть заветное желание заиметь собственную библиотечку с быстрой реализацией своей функции. Сортировка, хеш, СцепитьМассив() по условиям и т.д. полезные для форума? Отберем претендента, сделаю реализацию.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous, регистрозависимая, т.е. регистр имеет значение. Расчет через байтовый массив и Юникод. Думаю должны зайти и китайские знаки, можно проверить. Все остальные рассмотренные функции ВПР(), ИНДЕКС(), ПРОСМОТР() регистронезависимые, т.е. не различают регистр. Выходит VLOOKUP2() единственная различает регистр, может этим и будет полезна (кроме функций на VBA, но они медленнее раз в 20 - тестировал на 8 ядерном ЦП).
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Function VLOOKUP2_VBA(ArreyFind As Range, ArreyResult As Range, FIND)
Dim arr1(), arr2(), i As Long, j As Long
arr1 = ArreyFind.Value
arr2 = ArreyResult.Value
For i = 1 To UBound(arr1)
For j = 1 To UBound(arr1, 2)
If arr1(i, j) = FIND Then VLOOKUP2_VBA = arr2(i, j): Exit Function
Next
Next
End Function
обгоняет более чем в 20 раз (на 8 ядрах, т.к. VLOOKUP2 выполняется параллельно в 8 потоках). Обе функции можно применять так:
У кого есть заветное желание заиметь собственную библиотечку с быстрой реализацией своей функции
у меня есть хочется всё, конечно, но, если уж выбирать, то вот мои кандидаты на "ускорение":
Список
Код
'===================================================================================================================
'Получение текста из диапазона ячеек (http://excelvba.ru/code/Range2TXT)
'===================================================================================================================
Public Function PRDX_RangeToText(ByRef WF_ra As Range, Optional ByVal WF_ColumnsSeparator As String = "%%%", Optional ByVal WF_RowsSeparator As String = "%%%", Optional ByVal WF_AreasSeparator As String = "%%%") As String
Dim WF_ar As Range
Dim WF_arr
Dim WF_i&, WF_j&
Dim WF_txt$
If WF_ra.Cells.Count = 1 Then PRDX_RangeToText = WF_ra.Value: Exit Function
If WF_ra.Areas.Count > 1 Then
For Each WF_ar In WF_ra.Areas
PRDX_RangeToText = PRDX_RangeToText & WF_AreasSeparator$ & PRDX_RangeToText(WF_ar, WF_ColumnsSeparator$, WF_RowsSeparator$)
Next WF_ar
PRDX_RangeToText = Mid$(PRDX_RangeToText, Len(WF_AreasSeparator) + 1)
Exit Function
End If
WF_arr = WF_ra.Value
For WF_i = LBound(WF_arr, 1) To UBound(WF_arr, 1)
WF_txt = "": For WF_j = LBound(WF_arr, 2) To UBound(WF_arr, 2): WF_txt = WF_txt & WF_ColumnsSeparator$ & WF_arr(WF_i, WF_j): Next WF_j
PRDX_RangeToText = PRDX_RangeToText & Mid$(WF_txt, Len(WF_ColumnsSeparator$) + 1) & WF_RowsSeparator$
Next WF_i
PRDX_RangeToText = Left$(PRDX_RangeToText, Len(PRDX_RangeToText) - Len(WF_RowsSeparator))
End Function
'===================================================================================================================
Public Function PRDX_ArrayTranspose(WF_arr())
Dim WF_tmpArr(), WF_x
Dim WF_i&, WF_r&, WF_c&
If LBound(WF_arr) = 0 Then GoTo ar1
ReDim WF_tmpArr(LBound(WF_arr, 2) To UBound(WF_arr, 2), LBound(WF_arr, 1) To UBound(WF_arr, 1))
For WF_r = LBound(WF_arr, 2) To UBound(WF_arr, 2)
For WF_c = LBound(WF_arr, 1) To UBound(WF_arr, 1)
WF_tmpArr(WF_r, WF_c) = WF_arr(WF_c, WF_r)
Next WF_c
Next WF_r
GoTo fin
ar1:
ReDim WF_tmpArr(1 To UBound(WF_arr) + 1, 1 To 1)
For WF_i = 1 To UBound(WF_arr) + 1
WF_tmpArr(WF_i, 1) = WF_arr(WF_i - 1)
Next WF_i
fin: PRDX_ArrayTranspose = WF_tmpArr
End Function
'=========================================================================================================================
Public Function PRDX_Array2xTo1x(WF_arr())
Dim WF_tmpArr(), WF_x
Dim WF_n&, WF_i&
WF_n = UBound(WF_arr, 1) * UBound(WF_arr, 2) - 1: ReDim WF_tmpArr(0 To WF_n): WF_i = 0
For Each WF_x In WF_arr
WF_tmpArr(WF_i) = WF_x: WF_i = WF_i + 1
Next WF_x
PRDX_Array2xTo1x = WF_tmpArr
End Function
'=========================================================================================================================
'Переделано в функцию на основе данной процедуры: https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=8&TID=6998&TITLE_SEO=6998&MID=281882#message281882
'=========================================================================================================================
Public Function PRDX_Array1xSort(WF_arr())
Dim WF_v, WF_u&, WF_d&, WF_f%, WF_temp()
WF_temp = WF_arr
WF_f = LBound(WF_temp): WF_d = WF_f
For WF_u = WF_f + 1 To UBound(WF_temp)
If WF_temp(WF_u) < WF_temp(WF_d) Then
WF_v = WF_temp(WF_d): WF_temp(WF_d) = WF_temp(WF_u): WF_temp(WF_u) = WF_v
WF_u = WF_d - 1: WF_d = WF_u - 1: If WF_u < WF_f Then WF_d = WF_u: WF_u = WF_f
End If
WF_d = WF_d + 1
Next
PRDX_Array1xSort = WF_temp
End Function
'=========================================================================================================================
Public Function PRDX_IsUniqArr_Dict(WF_arr) As Boolean
Dim WF_x
On Error GoTo ex
With CreateObject("Scripting.Dictionary")
For Each WF_x In WF_arr
If Len(WF_x) > 0 Then .Add WF_x, 0
Next WF_x
End With
PRDX_IsUniqArr_Dict = True: Exit Function
ex:PRDX_IsUniqArr_Dict = False
End Function
'=========================================================================================================================
Public Function PRDX_GetUniqArrFromArr(WF_arr)
Dim WF_x, WF_iTemp
With CreateObject("Scripting.Dictionary")
For Each WF_x In WF_arr
If Len(WF_x) > 0 Then WF_iTemp = .Item(WF_x)
Next WF_x
PRDX_GetUniqArrFromArr = .Keys
End With
End Function
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous, да как обычная надстройка. Можно открыть как файл, можно установить в папке/списке для надстроек. Гляну ваш список) Был у меня ещё вариант функции, со входящей строкой, а выходящие данные по маске, часто спрашивают только русские буквы, цифры или что-то удалить из текста и т.д. Но здесь нужно грамотно составить маску, что бы была универсальность. Может такие функции уже есть на VBA?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous, 6 функций это неплохо, нужно отобрать одну, и что бы форуму польза была. Пока только от вас варианты пришли. Расскажите, что они делают, в чем будет польза? Подождем и других участников. А пока отбираем что-то толковое, могу написать конкретно для вас, реализацию одной выбранной вами функции (как выше писал), но которая действительно нужна вам в таком исполнении. Подумайте, возможно такой пока у вас нет, но будет в будущем.
Немного матчасти для тех, кто заинтересуется темой, и будет коллегой в разработке и обсуждении некоторых актуальных вопросов по данной тематике. Программирование с использованием API C в Excel
bedvit: могу написать конкретно для вас, реализацию одной выбранной вами функции … которая действительно нужна вам в таком исполнении
спасибо большое! Тут надо подумать)) проблема в том, что я не понимаю, где и в каких случаях API C даёт наибольший выигрыш. В копилке лежит тема о быстрой сортировке — до сих пор не разобрался (к своему стыду). Можно ли улучшить её вашими методами?
Цитата
bedvit: Расскажите, что они делают, в чем будет польза?
это "базовые" (как я их называю) функции. Лежат в личной надстройке и напрямую используются редко, но гораздо чаще — в составе других макросов. Иными словами, чтобы не прописывать в коде процедуру сортировки массива или отбора из него уникальных элементов, я просто вызываю нужную функцию, передаю в неё массив и, на выходе, получаю отсортированный или уникальный массив.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous написал: тема о быстрой сортировке — до сих пор не разобрался (к своему стыду). Можно ли улучшить её вашими методами?
гляну. Уникальный массив это как? Итак намечается: 1. Сцепить ячейки по условию, в одну строку, с задаваемым разделителем. 2. Обработка строки по маске. 3. Сортировка массивов. Возможно и удаление дубликатов в этой же реализации. По дубликатами вопрос, удаляем всю строку, столбец или конкретное значение, где ищем дубликаты, везде, по какому либо измерению? Размерность массива - 2?
массив (обычно одномерный или двумерный, в котором одно из измерений = 1 (строка/столбец, забранные в массив с листа)), состоящий из уникальных элементов.
Цитата
bedvit: …удаляем всю строку, столбец или конкретное значение, где ищем дубликаты, везде, по какому либо измерению? Размерность массива - 2?
предлагаю лист затрагивать минимально (только, чтобы забрать значения, в массив, например), т.к. не думаю, что на листе будет выигрыш в скорости (ничем не обоснованная чуйка). Функция получает массив и возвращает такой же размерности, но без дублей в каждой размерности (между размерностями "дубли" могут быть). Либо упростить до 1х - 2х массивов.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
bedvit, приветствую! У нас с вами какая-то ментальная связь, кажется
Писал сегодня с утра Виктору (модератор) по поводу расширения этой (уже изменил название на более обобщённое) своей темы. Он не ответил и завтра скину код и файл с более десятка макросами на сравнение различных действий с массивами (на свой страх и риск).
Так вот - хотел вам в личку написать, чтобы глянули. Завтра после обновления буду рад вашим комментариям. Я был очень удивлён некоторым результатам…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Как обещал вернулся к данной теме, написал сортировку одномерного массива. Можно протестировать, высказать свою точку зрения на данный механизм работы в VBA. Удобен или нет, стоит ли развивать это направление или все это сложно и нужно только единицам.
bedvit, мне это точно нужно ещё бы сортировку двумерного массива и/или сортировку одномерных по одному из них. Ещё можно фильтрацию двумерного массива по столбцу или одномерных по массиву индексов (как тут)
Проблема с внедрением надстройки. Двойной клик по файлу вызывает аварийное завершение Excel (был закрыт перед кликом), а при простом подключении, как надстройки, Excel не "видит" ваших библиотек
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous, по поводу индексов - думаю добавлю. По установке - библиотека х32 открывается EXCEL32, x64 - EXCELx64. Именно битность Excel играет роль, а не WIN. Попробуйте, если не открывается пришлите в личку скриншот или описание ошибки.
bedvit, туго в личке со скринами))) Двойной клик по файлу (вне зависимости 32х или 64х) вызывает вот такую ошибку… Не зависит, подключена надстройка или нет. При подключении надстройки, она не отображается в Project Explorer
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Да, ничего не ясно. Что написано в подробностях (показать подробности)? Какая система, офис (битность, версия)? Есть возможность протестировать на другой машине? У меня две тестовые машины с разной битность офиса, везде отрабатывает как надо. Не могу пока предположить в чем дело. Рабочий ПК?
Сигнатура проблемы: Имя события проблемы: APPCRASH Имя приложения: EXCEL.EXE Версия приложения: 16.0.10325.20082 Отметка времени приложения: 5b525820 Имя модуля с ошибкой: KERNELBASE.dll Версия модуля с ошибкой: 6.1.7601.18409 Отметка времени модуля с ошибкой: 5315a05a Код исключения: c06d007f Смещение исключения: 000000000000940d Версия ОС: 6.1.7601.2.1.0.768.2 Код языка: 1049
Дополнительные сведения об этой проблеме: LCID: 1049 skulcid: 1049
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Здесь пишут, что могут быть проблемы со сторонними надстройками (не могу утверждать, что это наш случай, но не исключено). Сможете, для эксперимента, отключить все надстройки, открыть только мою.
там про Word, вроде… Всё отключил, но даблклик всё так же крашит и в эксплорере не отображается… На другом компе всё норм — в Immediate увидел Sort
Сигнатура проблемы:
Имя события проблемы: APPCRASH Имя приложения: EXCEL.EXE Версия приложения: 16.0.10325.20082 Отметка времени приложения: 5b525820 Имя модуля с ошибкой: KERNELBASE.dll Версия модуля с ошибкой: 6.1.7601.18409 Отметка времени модуля с ошибкой: 5315a05a Код исключения: c06d007f Смещение исключения: 000000000000940d Версия ОС: 6.1.7601.2.1.0.768.2 Код языка: 1049
Дополнительные сведения об этой проблеме: LCID: 1049 skulcid: 1049
а нельзя просто ваш код в модуль своей надстройки забрать?
UPD: разобрался. Для запуска вашей надстройки необходимо, чтобы все макросы запускались по-умолчанию (что не есть гут). Есть возможность поправить? И вопрос о том, как добавить ваши методы в свою надстройку также очень интересен
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Написано про Excel, но это не важно, видимо это локальная проблема на конкретном ПК, как я понял связанная с наличием других продуктов, надстроек VBA, макросов и возможно каких-либо еще подключенных сторонних продуктах. Возможно, рекомендации отсюда помогут: тыц,тыц, тыц, тыц. Проверил свою библу на 4 ПК, то же, как у вас, вин7, офис 16 х64 - все работает.
Цитата
Jack Famous написал: а нельзя просто ваш код в модуль своей надстройки забрать?
Можно забрать библу, и ее подключать, когда необходимо (хранить в надстройке, когда нужно выгрузить, подключить, отключить, когда будет не нужна), к примеру, с помощью этого инструмента.
Jack Famous написал: UPD: разобрался. Для запуска вашей надстройки необходимо, чтобы все макросы запускались по-умолчанию (что не есть гут). Есть возможность поправить?
Хм, странно, у меня на двух разных системах х64 rus и х32 eng, запускается все норм, см. скрины. Запускал и локально с ПК и из сетевой папки с разными настройками безопасности, в т.ч. указанными выше, на сообщение открыть надстройку - жмем да, и все ОК. У вас точно выключены все свои надстройки, макросы, события?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous написал: Как обойтись совсем без вашей надстройки
если имелось ввиду поделится кодом, то нет проблем, мне не жалко, но нужно понимать следующее: 1. вот упрощенная схема от этапа формирования алгоритм до формирования бинарника. Читаем Процесс компиляции программ на C++. 2. итого у меня есть три кода моего алгоритма: 1.Написанный на С++. 2.На ассемблере 3.Бинарный. Одним из них я поделился. Два других без компилятора С++ и компановщика/линковщика, боюсь, вам не пригодятся.
Цитата
Jack Famous написал: как забрать библу, и ее подключать, когда необходимо (хранить в надстройке…)
все просто, прилагаю пример (вложенная надстройка без кода, тестовая, выдает сообщение - просто замените её на рабочую) - с рабочей надстройкой файл не пролез.
Цитата
Jack Famous написал: Как при этом обойтись без вашего файлового менеджера? Просто скопировать к себе в надстройку и вызывать в любой момент…
написать свой ФМ Или скопировать код с моего листа на ваш, в вашу надстройку и у вас этот лист станет файловым менеджером.
Смотрите: 1. У меня есть надстройка "*.xlam" 2. У вас есть надстройка "*.xll"
Вопрос: как мне скопировать коды/библиотеки/всё_нужное_для_того_чтобы_работать из вашей надстройки в свою?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄