Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » bedvit
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1 2 3 След.
Вставить данные на лист Excel без преобразования (xlSet)
 
#
17.04.2024 15:52:30
Моё почтение, джентльмены!
Инструмент для вставки данных на лист Excel без преобразования.
т.е. "1" так и вставится как текст, а не как число.

Не нужен апостроф, не нужен формат ячейки.
Нужна надстройка BedvitXLL(бесплатная).

Так же быстро заполняет диапазон одним значением.

Использована функция xlSet из Excel C API.

Функция/Метод XLLcmdE12xlSet(XCHAR * param, LPXLOPER12 param2, LPXLOPER12 pxReference, LPXLOPER12 pxValue)
param - командная строка XLL API - см. "XLL API":
   1й параметр - Режим диалога для комманд меню XLL - см. "Диалог"
param2 – зарезервирован

pxReference - Прямоугольная ссылка (адрес), описывающая целевую ячейку или ячейки. Адрес должен описывать смежные ячейки.

pxValue - Значение или значения, помещаемые в ячейку или ячейки.

Аргумент pxValue
pxValue может быть значением или массивом. Если это значение, этим значением заполняется весь диапазон назначения. Если это массив, элементы массива помещаются в соответствующие расположения в прямоугольнике.

Если для четвертого аргумента используется горизонтальный массив, он дублируется вниз, чтобы заполнить весь прямоугольник. Если используется вертикальный массив, он дублируется вправо для заполнения всего прямоугольника. Если вы используете прямоугольный массив, и он слишком мал для прямоугольного диапазона, в который вы хотите его поместить, этот диапазон заполняется исходными данными размером с массив, а остальной диапазон заполняется #Н/Д.

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

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

Ограничения
Невозможно отменить xlSet . Кроме того, он удаляет все сведения об отмене, которые могли быть доступны ранее.
XlSet может помещать в ячейки только константы, а не формулы. Максимальная длина помещаемой строки 8190 символов.


Возвращает код ошибки: 0 - команда выполнена успешно и Error 2036, #NUM!, #ЧИСЛО! - если ошибка.


Пример использования:
Код
Option Explicit

Sub TestXLLcmdE12xlSet()
    Dim i, testSize As Long: testSize = 2
    Dim arrOrValue: ReDim arrOrValue(1 To testSize, 1 To 1)
    
    For i = 1 To testSize
        arrOrValue(i, 1) = Str(i) 'MAX количество символов для ячейки: 8190
    Next
    
    'Варианты использования:
    '1.Выводим массив или значение по указанному диапазону на лист Excel
    Debug.Print Application.RUN("XLLcmdE12xlSet", "", 0, Range("a1:a2").Address, arrOrValue)
    
    '2. Помещаем в диапазон значение "1"
    Debug.Print Application.RUN("XLLcmdE12xlSet", "", 0, Range("b1:b2").Address, "1")
    
    '3. Выводим массив по указанному диапазону на лист Excel, первый элемент = Empty
    arrOrValue(1, 1) = Empty 'первый элемент Empty
    Debug.Print Application.RUN("XLLcmdE12xlSet", "", 0, Range("c1:c2").Address, arrOrValue)
    
    '4 Очищаем заданный диапазон от данных
    [d1:d5] = 2 'заполняем данными (2) диапазон для теста
    Debug.Print Application.RUN("XLLcmdE12xlSet", "", 0, Range("d1:d2").Address) ' очищаем в заданном диапазоне

End Sub
Изменено: bedvit - 18.04.2024 11:31:00
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
Шифрование данных на листе Excel и в VBA
 
#
11.01.2024 09:23:05
Мое почтение, джентльмены!
В продолжении темы Variant Serialization and Deserialization
Сделал инструменты шифрования алгоритмами AES данных на листе Excel и в коде VBA.
Виды алгоритмов шифрования можно выбирать. В тесте работает алгоритм AES256:CBC.

Функционал:
1. Можно шифровать как отдельные значения так и диапазоны/массивы.
2. Шифровать данные можно прям на листе Excel, с дальнейшей расшифровкой нужного диапазона или всего листа.
3. Зашифрованные данные можно хранить в XLL как в виде значений (value2), так и в виде формул (formula)
4. Алгоритм шифрования AES256:CBC. Использована библиотека Crypto++
5. Пароль нигде не хранится, его знает только пользователь и при утере, расшифровать данные не получится никому :)
6. Зашифрованные диапазоны - независимые, т.е. можно каждый отдельный диапазон зашифровать со своим паролем, можно зашифровать диапазон дважды (для гиков :) )
7. Для данных у которых упаковка будет экономить размер итоговой зашифрованной строки (для массивов и длинных строк)  - используется алгоритм сжатия WinAPI:XPRESS_HUFF
8. Реализован механизм (shared string table), как и в Excel, для оптимизации размера одинаковых строк (для массивов).
9. Данные на листе Excel шифруются для каждой ячейки отдельно (для возможности хранить и расшифровывать данные независимо для каждой ячейки) с применением п,7.
Для VBA (одно значение или массив) зашифровываются в один массив байт, что позволяет применять и п.7 и п.8  
10. Итоговый результат шифрования (любого типа данных: строки, числа, ошибки и т.д.) - хранится в виде строки (массива зашифрованных байт).



Шифрование на листе Excel и хранение данный в XLL:



Шифрование данных VBA:

Функции:
1. VARIANT stringProtect = VariantAES256Encrypt(VARIANT variantIn, BSTR password, BSTR salt, LONG mode)
2. VARIANT variantUnProtect = VariantAES256Decrypt(VARIANT byteArrayIn, BSTR password, BSTR salt, LONG mode)


Можем обсудить, кому интересно, подробности и, возможно, внести новый функционал, если он нужен и не реализован.

Надстройка:
BedvitXLL64v5.0
Изменено: bedvit - 19.01.2024 00:05:59
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
Variant Serialization and Deserialization
 
#
19.12.2023 12:47:07
Мое почтение, джентльмены!
Cериализация и десериализация типа данных Variant, используемый в COM, VB, VBA, C++ и т.д.
Поддерживаются базовые типы и массивы. Объекты не сериализуются.
В некоторой степени - аналог CComVariant::ReadFromStream и CComVariant::WriteToStream

Использование простое, как обычная функция (предварительно подключив или открыв надстройку по ссылке чуть ниже и COM в автоматическом/ручном режиме):
Код
Sub TestVariantSerialization()
    'Dim bVBA As New BedvitCOM.VBA 'раннее связывание
    Dim bVBA As Object: Set bVBA = CreateObject("BedvitCOM.VBA") 'позднее связывание
    Dim t, arr, byteArr
    
    Range("A:B").value2 = "Tst Srl ёя"
    
    t = Timer
        byteArr = bVBA.VariantSerialization(Range("A:B").value2)
        arr = bVBA.VariantDeserialization(byteArr)
    Debug.Print "VariantSerialization+VariantDeserialization " & Timer - t & " s."
    Range("D:E").value2 = arr
    
End Sub


Особенности:
1. Cериализация в байтовый массив
2. Размер массива не может превышать 2^32 элементов (около 4Гбайт). Это ограничение самого  COM - массива. В С++ (в другом контейнере) сохранял файлы боле 4,5 Гб.
3. Реализован похожий механизм (shared string table), как и в Excel, для оптимизации размера одинаковых строк.



Надстройка BedvitXLL64v4.11beta
Изменено: bedvit - 19.12.2023 13:14:22
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
BedvitCOM: Like
 
#
08.06.2023 08:13:56
Мое почтение, джентльмены!
т.к. в С/С++ нет Like, решил сделать свою реализацию.
Аналог 100% (только бинарный режим)
Она оказалось немногим быстрее штатной, делюсь.
Прошу пользоваться, тестировать, добавлять свои шаблоны, и дать обратную связь по скорости и ошибкам, если таковые будут.

Speed test...
Pattern...'XYXZZXYXYXZZXY' Like '*X*X?*X*X?'
Like 2,015625
bVBA.Like: 1,617188
Pattern...'XYXZZXYXYXZZXY123-#*[[]?!!19Aa--/!\#*[[]?!!19Aa--' Like '*X*X?*X*X?***###*[[]][?][!]!1[?1-5-9][!B-Z][A-Za-z][a-][-a]'
Like 8,699219
bVBA.Like: 5,273438


Шаблон, на котором проводилось тестирование:
Скрытый текст


Код
Option Explicit

Sub TestLike()
    'Dim bVBA As Object: Set bVBA = CreateObject("BedvitCOM.VBA") 'позднее связывание
    Dim bVBA As New BedvitCOM.VBA
    Dim x(), i, j, n, nMax, x1, x2, y, t
    nMax = 10000000

    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "XYXZZXYXYXZZXY123-#*[[]?!!19Aa--/!\#*[[]?!!19Aa--": x(2, i) = "*X*X?*X*X?***###*[[]][?][!]!1[?1-5-9][!B-Z][A-Za-z][a-][-a]"       ' Speed test
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "XYXZZXYXYXZZXY": x(2, i) = "*X*X?*X*X?"       ' Speed test
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aBBBa": x(2, i) = "a*a"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "F": x(2, i) = "[A-Z]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "F": x(2, i) = "[!A-Z]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "a2a": x(2, i) = "a#a"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aM5b": x(2, i) = "a[L-P]#[!c-e]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "BAT123khg": x(2, i) = "B?T*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "CAT123khg": x(2, i) = "B?T*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "ab": x(2, i) = "a*b"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "a*b": x(2, i) = "a [*]b"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "axxxxxb": x(2, i) = "a [*]b"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "a [xyz": x(2, i) = "a [[]*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aM5b": x(2, i) = "a*?b"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aM5b": x(2, i) = "a*[1-4-9][!c-e]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aM55b": x(2, i) = "a*[1-4-9][!c-e]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aM55b": x(2, i) = "a*[1-45-9][!c-e]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aM5b": x(2, i) = "*#[!c-e]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "5*": x(2, i) = "5[*]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "?n": x(2, i) = "[?]n"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "a": x(2, i) = "[a-cdf]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "b": x(2, i) = "[a-cdf]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "c": x(2, i) = "[a-cdf]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "d": x(2, i) = "[a-cdf]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "f": x(2, i) = "[a-cdf]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "-": x(2, i) = "[-acdf]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "a": x(2, i) = "[-acdf]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "c": x(2, i) = "[-acdf]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "d": x(2, i) = "[-acdf]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "f": x(2, i) = "[-acdf]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "[": x(2, i) = "[ [ ]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "]": x(2, i) = "]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "abc_d": x(2, i) = "abc[_]d*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "abc_de": x(2, i) = "abc[_]d*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "abcd": x(2, i) = "abc[def]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "abce": x(2, i) = "abc[def]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "abcf": x(2, i) = "abc[def]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "abcdef": x(2, i) = "abc*[de]ef"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "abcyef": x(2, i) = "abc[xz]ef"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "abcxef": x(2, i) = "abc[xz]ef"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "abcyef": x(2, i) = "abc[!xz]ef"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "abcxef": x(2, i) = "abc[!xz]ef"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "ac5c5b": x(2, i) = "a*[1-56-9][!c-e]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "": x(2, i) = ""
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "": x(2, i) = "*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "": x(2, i) = "[]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "": x(2, i) = "[!]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "": x(2, i) = "[]*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "": x(2, i) = "[!]*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "1": x(2, i) = "[!]*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "1": x(2, i) = "[]*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "1": x(2, i) = "[!]*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "1": x(2, i) = "[!]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "1": x(2, i) = "*[!]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "1": x(2, i) = "*[]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "1": x(2, i) = "#[]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "1": x(2, i) = "#[!]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "12": x(2, i) = "#[!]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "12": x(2, i) = "#[!]*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "123": x(2, i) = "*[!]*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "1!3": x(2, i) = "*[!]*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "!": x(2, i) = "*[!]*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "!": x(2, i) = "[!]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "!a": x(2, i) = "*[!a]*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "!a": x(2, i) = "[!a]*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "!a": x(2, i) = "*[!a]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "!a": x(2, i) = "[!a]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "a": x(2, i) = "[!a]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "b": x(2, i) = "[!a]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "2": x(2, i) = "#[]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "*": x(2, i) = "[*]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "1": x(2, i) = "[*]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "!": x(2, i) = "[!-!]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "1": x(2, i) = "[!-!]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "!": x(2, i) = "[-!]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "!": x(2, i) = "[!-]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "-": x(2, i) = "[!-]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "-": x(2, i) = "[-]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "***": x(2, i) = "*[*]*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "???": x(2, i) = "?[?]?"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "###": x(2, i) = "#[#]#"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "[[[[[": x(2, i) = "[[]?*[[]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "abс": x(2, i) = "a[]b[]с[]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "abс": x(2, i) = "a*[]b*[]с*[]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "abс": x(2, i) = "a[]*b[]*с[]*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aaa": x(2, i) = "aaa[a]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aaaba": x(2, i) = "aaa[!aaa]a"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aaaba": x(2, i) = "aaa[!abb]a"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aaaba": x(2, i) = "aaa[!a?]a"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aaab": x(2, i) = "aaa[!a?]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aaa?a": x(2, i) = "aaa[!a?]a"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aaa?]": x(2, i) = "aaa[!a?]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "!a]": x(2, i) = "*[!a]]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aaaba": x(2, i) = "aaa[!a#]a"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aaab": x(2, i) = "aaa[!a#]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aaa#a": x(2, i) = "aaa[!a#]a"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aaa#]": x(2, i) = "aaa[!a#]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aaa*]": x(2, i) = "aaa[!a*]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aaa": x(2, i) = "a*[]*[a]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aaa": x(2, i) = "a*[a]*[]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aaa": x(2, i) = "a*[]*[]"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "abaa": x(2, i) = "a*[!a]*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aaba": x(2, i) = "a*[!a]*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "aaab": x(2, i) = "a*[!a]*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "1": x(2, i) = "1[!*]*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "[]": x(2, i) = "[!*]*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "-": x(2, i) = "[!-]*"
    i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "-": x(2, i) = "[!-]*"
    'i = i + 1: ReDim Preserve x(1 To 2, 1 To i): x(1, i) = "a [xyz": x(2, i) = "a [*"   ' Throws Error 93 (invalid pattern string).
    
    
    For n = 1 To UBound(x, 2)
        'Debug.Print "{L""" & x(1, n) & """, L""" & x(2, n) & """" & IIf(x(1, n) Like x(2, n), ", L""True""", ", NULL") & "},"
        Debug.Print (x(1, n) Like x(2, n)) = bVBA.Like(x(1, n), x(2, n))
    Next


    Debug.Print "Speed test..."
    Debug.Print "Pattern...'XYXZZXYXYXZZXY' Like '*X*X?*X*X?'"
    t = Timer
    For n = 1 To nMax
        x1 = "XYXZZXYXYXZZXY" Like "*X*X?*X*X?" '1.97
    Next
    Debug.Print "Like " & Timer - t

    t = Timer
    For n = 1 To nMax
        x2 = bVBA.Like("XYXZZXYXYXZZXY", "*X*X?*X*X?") '1.59
    Next
    Debug.Print "bVBA.Like: " & Timer - t

    Debug.Print "Pattern...'XYXZZXYXYXZZXY123-#*[[]?!!19Aa--/!\#*[[]?!!19Aa--' Like '*X*X?*X*X?***###*[[]][?][!]!1[?1-5-9][!B-Z][A-Za-z][a-][-a]'"
     t = Timer
    For n = 1 To nMax
        x1 = "XYXZZXYXYXZZXY123-#*[[]?!!19Aa--/!\#*[[]?!!19Aa--" Like "*X*X?*X*X?***###*[[]][?][!]!1[?1-5-9][!B-Z][A-Za-z][a-][-a]" '8.29
    Next
    Debug.Print "Like " & Timer - t

    t = Timer
    For n = 1 To nMax
        x2 = bVBA.Like("XYXZZXYXYXZZXY123-#*[[]?!!19Aa--/!\#*[[]?!!19Aa--", "*X*X?*X*X?***###*[[]][?][!]!1[?1-5-9][!B-Z][A-Za-z][a-][-a]") '4.92
    Next
    Debug.Print "bVBA.Like: " & Timer - t

    
End Sub


Обсуждение на cyberforum

beta-версия надстройки

Матчасть, которую использовал.
Изменено: bedvit - 14.06.2023 22:26:51
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
BedvitCOM: Split
 
#
28.04.2023 13:17:23
Быстрая замена штатному Split

Split (
[in] BSTR stringIn, - входящая строка
[in] BSTR delimiter,  - разделитель (может быть несколько символов)
[in, defaultvalue(0)] LONG setLowerBound,  - нижняя граница массива (по умолчанию=0)
[in, defaultvalue(0)] VARIANT_BOOL multiThreadingON, - режим многопоточности (по умолчанию отключен)
[out, retval] VARIANT* arrayOut) - результат: массив Variant/BSTR
)

Стенд:
Код
Sub bCOMSplit()
Dim str, t, i, arr, arr2, arr3, iMax
Dim bCOM As New BedvitCOM.VBA 'Ранее связывание
'Set bCOM = CreateObject("BedvitCOM.VBA") 'Позднее связывание
'Debug.Print bCOM.Filename 'расположение библиотеки
'Debug.Print bCOM.Version 'версия библиотеки
str = String$(1000000, "2") & ":"
iMax = 1

t = Timer()
For i = 1 To iMax
    arr = Split(str, "22")
Next
Debug.Print "Split: " & Timer() - t

t = Timer()
For i = 1 To iMax
    arr2 = bCOM.Split(str, "22") 'однопоточный режим, массив начиная с 0
Next
Debug.Print "bCOM.Split: " & Timer() - t

t = Timer()
For i = 1 To iMax
    arr3 = bCOM.Split(str, "22", 2, 1) 'многопоточный режим, массив начиная с 2
Next
Debug.Print "bCOM.SplitMultiThreading: " & Timer() - t

End Sub


Тайминги, секунд на 1 млн символов, 500 тыс. элементов в массиве:
Split: 1,035156
bCOM.Split: 0,0625
bCOM.SplitMultithreading: 0,03125

Библиотека: beta-версия х64 (как подключить: открыть XLL как обычный Excel-файл или подключить как обычную надстройку Excel, включить СОМ-библиотеку в командном меню XLL)
Изменено: bedvit - 29.04.2023 10:09:30
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
BedvitCOM: хеширование - SHA, MD. Блочный шифр - AES 128 bit
 
#
16.01.2023 12:06:05
Моё почтение, джентльмены!
Начиная с BedvitCOM v3.4 и BedvitXLL v.4.5
Функция HashStringSHA(StringIn, VersionSHA) больше не поддерживается.

Вносится новый функционал на основе кодирования строки в Юникод UTF-8
Скрытый текст


1. SHAstrUTF8(stringIn, versionSHA, charLower, stringOut) - Алгоритмы шифрования SHA.
Параметры функции:
1.stringIn - входящая строка
2.versionSHA - версия алгоритма SHA
3.charLower - регистр символов

Поддержка следующих алгоритмов (+ новейшие SHA3) :
versionSHA = 1      , SHA1
versionSHA = 2224, SHA2_224bit
versionSHA = 2256, SHA2_256bit
versionSHA = 2384, SHA2_384bit
versionSHA = 2512, SHA2_512bit
versionSHA = 3224, SHA3_224bit
versionSHA = 3256, SHA3_256bit
versionSHA = 3384, SHA3_384bit
versionSHA = 3512, SHA3_512bit

2. MDstrUTF8(stringIn, versionMD, charLower, stringOut) - Алгоритмы шифрования MD.
Параметры функции:
1.stringIn - входящая строка
2.versionMD- версия алгоритма SHA
3.charLower - регистр символов

Поддержка следующих алгоритмов :
versionMD= 5, MD= 5

3. AES128strUTF8(stringIn, key, decrypt, mode, initializationVectorIV, str_format_hex, stringOut) - методы применения блочного шифра (алгоритма), позволяющий преобразовать последовательность блоков открытых данных в последовательность блоков зашифрованных данных.
Параметры функции:
1.stringIn - входящая строка
2.key- ключ (размер 16, 32 byte)
3.decrypt- Рашифровка:encrypti=0, по умолчанию. Расшифровка:decrypt=1
4.mode- режимы работы -это методы работы блочного шифра. Вводится как числом, так и кодом (как удобнее), см.ниже
5.initializationVectorIV -  вектор инициализации (для всех режимов, кроме ECB, см. ниже)
6.str_format_hex - формат вывода/ввода зашифрованной строки. По умолчанию  Base64 = 0, Hex = 1

Поддержка следующих режимов работы mode:
0 - "ECB"
1 - "CBC"
2 - "OFB"
3 - "CFB"
4 - "CBC-CTS"
5 - "CTR"

использована библиотека Crypto++
подробное описание mode:
1.Wiki
2.Crypto++
3.Другой

Код:
Код
Sub Test_SHA_MD_AES128()
    Dim bVBA As Object: Set bVBA = CreateObject("BedvitCOM.VBA")
    Dim x, mode
    
    'SHA
    Debug.Print bVBA.SHAstrUTF8("SHA Algorithm Test 128 bit Тест Ё", 3512, True) 'versionSHA = 3512(SHA3-512bit), charLower = true
   
    'MD
    Debug.Print bVBA.MDstrUTF8("MD Algorithm Test 128 bit Тест Ё", 5) 'versionMD = 5(MD)
    
    'AES128
    Debug.Print bVBA.AES128strUTF8("AES Algorithm Test 128 bit Тест Ё", "1111111111111111", 0, "ECB", "", 1) 'mode=0="ECB", Text Encryption Format=1(Hex)
    'mode = { L"0",L"ECB", L"1",L"CBC",L"2", L"OFB",L"3", L"CFB",L"4", L"CBC-CTS",L"5",L"CTR"}
    For mode = 1 To 5
        x = bVBA.AES128strUTF8("AES Algorithm Test 128 bit Тест Ё", "1111111111111111", 0, mode, "2222222222222222", 0) 'Text Encryption Format=0(Base64), Initialization vector (IV)="2222222222222222"
        Debug.Print x
        x = bVBA.AES128strUTF8(x, "1111111111111111", 1, mode, "2222222222222222", 0) 'decrypt=true
        Debug.Print x
    Next
End Sub


Beta-версия (х64)
Изменено: bedvit - 17.01.2023 10:28:57
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
Инструменты для работы с массивами COM (VBA) - ReDim с сохранением данных и возможностью изменять любую размерность
 
#
20.12.2022 16:36:38
Моё почтение, джентльмены!
Продолжение темы Инструменты для работы с массивами COM (VBA) - ReDimPreserve для 2х измерений
Новый функционал отличается бОльшей универсальность, возможностью изменять как начало так и конец размерностей (поддерживается одномерные и двумерные массивы)
Информация сохраняется, если не обрезается принудительно. Для созданный блоков массива задаются значения Empty.
Можно обрезать/добавлять элементы, как в начало, так и в конец любой размерности массива.

ArrayReDim(VARIANT* arrayInOut, LONG lLboundRow, LONG rowStartChange, LONG rowEndChange, LONG lLboundCol, LONG colStartChange, LONG colEndChange)
1.arrayInOut - массив (Variant)
2.lLboundRow - новая нижняя граница для строк
3.rowStartChange - изменения для начала измерения строк ("-"обрезаем, "+"добавляем новые строки)
4.rowEndChange - изменения для конца измерения строк ("-"обрезаем, "+"добавляем новые строки)
5.lLboundCol - новая нижняя граница для столбцов
6.colStartChange - изменения для начала измерения столбцов ("-"обрезаем, "+"добавляем новые столбцы)
7.colEndChange - изменения для конца измерения столбцов ("-"обрезаем, "+"добавляем новые столбцы)

Код
Option Explicit

'изменение отсчета нижней границы массива, обрезка элементов(-) или добавление(+)
'в нужной размерности(начало массива, конец, для строк и для столбцов)

Sub TestArrayReDim()
'Dim a As BedvitCOM.VBA: Set a = New BedvitCOM.VBA
Dim bVBA As Object: Set bVBA = CreateObject("BedvitCOM.VBA")
Dim testSize As Long: testSize = 5
Dim i, t, arrTmpV
 
Dim ArrV1: ReDim ArrV1(0 To testSize)
Dim ArrV2: ReDim ArrV2(0 To testSize, 0 To 1)

For i = 0 To testSize
    ArrV1(i) = Format$(Int(Rnd * 1000), "0000")
    ArrV2(i, 0) = Format$(Int(Rnd * 1000), "0000")
    ArrV2(i, 1) = Format$(Int(Rnd * 1000), "0000")
Next

arrTmpV = ArrV1
'нижняя граница = 1, первый элемент массива обрезаем, добавляем последний
bVBA.ArrayReDim arrTmpV, 1, -1, 1
arrTmpV = ArrV2
'нижняя граница для строк= 1, первый элемент массива обрезаем (строки), добавляем последний (строки),
'нижняя граница для столбцов= 1, первый элемент массива обрезаем (столбцы), добавляем последний (столбцы),
bVBA.ArrayReDim arrTmpV, 1, -1, 1, 1, -1, 1
 
End Sub


Beta-версия

Прошу тестировать и дать обратную связь, если инструмент годный.
Изменено: bedvit - 21.12.2022 15:50:56
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
Инструменты для работы с массивами COM (VBA) - ReDimPreserve для 2х измерений
 
#
21.10.2022 22:26:11
Моё почтение, джентльмены!
1)Новый инструмент: ReDim Preserve для 2х измерений (с возможностью изменять все два измерения и все две нижние границы).
Порядок данных сохраняется в рамках измерения (т.к. как у стандартной ReDim Preserve). Данные тоже сохраняются.
Beta-версия на тестирование.
HRESULT ReDimPreserve2D([in, out] VARIANT* array_in_out, LONG lLbound0, LONG cElements0, LONG lLbound1, LONG cElements1);
array_in_out-массив
lLbound0 - нижняя граница для выбранного измерения
cElements0 - размер для выбранного измерения
lLbound1 - нижняя граница для следующего измерения
cElements1 - размер для следующего измерения

Код
Sub TestReDimPreserve2D()
    Dim bVBA As Object: Set bVBA = CreateObject("BedvitCOM.VBA")
    Dim arrV As Variant
    
    arrV = Worksheets("Стоп-слова").Range("A1:F2").Value2
    bVBA.ReDimPreserve2D arrV, 1, 7, 1, 3
   
End Sub


2)Новый инструмент: преобразование размерности и нижних границ без изменения и порядка данных (в рамках всего массива)
[id(26), helpstring("ArrayDtoD")] HRESULT ArrayDtoD([in, out] VARIANT* array_in_out, [in, defaultvalue(0)]LONG lLbound0, [in, defaultvalue(0)]LONG cElements0, [in, defaultvalue(0)]LONG lLbound1, [in, defaultvalue(0)]LONG cElements1, ...);
array_in_out-массив, обязательно, остальное по умолчанию, если все=0, значит в одномерный массив с ниж.границей=0
lLbound0 - нижняя граница для выбранного измерения
cElements0 - размер для выбранного измерения
lLbound1 - нижняя граница для следующего измерения
cElements1 - размер для следующего измерения
...до 10 измерений.
Быстрее чем ReDimPreserve2D, т.к. не нужно перераспределять данные в памяти, только изменение размерностей и границ (данные сохраняются в первоначальном порядке)

Код
Sub TestArrayDtoD()
    Dim bVBA As Object: Set bVBA = CreateObject("BedvitCOM.VBA")
    Dim arrV As Variant
    
    arrV = Worksheets("Стоп-слова").Range("A1:F2").Value2
    bVBA.ArrayDtoD arrV 'в одномерный массив с нижней границей по умолчанию = 0
    bVBA.ArrayDtoD arrV, 1 'в одномерный массив с нижней границей = 1
   
End Sub


Beta-версия

Код открыт (С/С++), выкладываю ниже, на случай, если у кого-то будут идеи по оптимизации
Скрытый текст
Изменено: bedvit - 22.10.2022 10:06:48
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
Использование BedvitCOM.dll в своем проекте на Python
 
#
18.10.2022 14:08:09
Пока не знаю, будет ли отдельный проект по автоматизации для Python, но те, кто пользуется BedvitCOM.dll, могут использовать её в своем проекте и на Python (в т.ч. и для Excel, используя xlrd, xlwt, xlutils или openpyxl и т.д.)
Регистрируем, пользуемся.
Код
# использование BedvitCOM-DLL
from win32com import client
bCOM = client.DispatchEx('BedvitCOM.BignumArithmeticInteger')
bCOM.Factorial (0, 1024)
print(bCOM.Bignum (0))


Все строковые функции работают, работает длинная арифметика.
Будет ли работать функционал меняющий данные на месте, массивы (сортировка, фильтр) - непонятно, нужно тестировать.
Сейчас хочу попробовать подключить фильтр, протестировать, к примеру на задаче на фильтрацию по 2000 условиям.
Пока вся сложность в массивах.
Изменено: bedvit - 20.10.2022 20:11:03
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
Как добавить библиотеку BedvitCOM.dll в свой проект для Excel
 
#
17.10.2022 20:23:59
В общем-то ничего сложного: добавляем в ресурсы листа Excel (там же и код) и вызываем по мере необходимости.
Сделал простой пример, весь функционал в одном листе (код и ресурсы - упакованные библиотеки)
Вообще, способов есть несколько.
Был и второй, через класс - класс в деструкторе сам отключает библиотеку при завершении программы, но нужно переносить модуль класса, а в первом варианте только код листа "ByteSheet"
Автоматическое подключение BedvitCOM.dll, без использования BedvitXLL (если будет интересно могу сделать пример/тему и для BedvitXLL).
т.е. незаметно для пользователя, без лишних меню и без прав администратора (все под пользователем, и BedvitXLL, кстати так же работает и распаковывает BedvitCOM)
Антивирусы не любят такую упаковку в VBA, да и вообще VBA

Проверяю здесь
https://opentip.kaspersky.com/

по мере появления вопросов буду пояснять, что не понятно, если будет интересна данная тема.
К обсуждению.

Файл-пример.

Как испрльзовать:
1. Загрузить, удалить (обновить) библиотеки BedvitCOM32, BedvitCOM64 можно с помощью команды Start_Menu на листе ByteSheet. Этот лист нужен для хранения этих библиотек. Это единственное что нужно перенести в ваш проект, лист с кодом, всё.
2. Для раннего связывания нужно запускать интциализацию библиотеки в отдельной процедуре (см. код в кнопке). Для позднего можно все в одной.
3. Любой код можно писать в процедуре test и любых других, включив их в первоначальный код, где происходит инициализация.Это нужно для раннего связывания. Для позднего можно делать инициализацию библиотеки прямо в своем коде. Но прошу помнить, что жто время. Для увеличения быстродействия, библу лучше подключать один раз на весь период расчета. Не в каждой выполняемой фкнкции включать/выключать.

Собственно всё просто.



bedvit 2022.12.21 - Новый установщик
Механизм регистрации BedvitCOM v2 упрощенный (без вызова Regsvr32), позднее связывание (не нужен доступ к объектной модели VBA)
BedvitCOM регистрируется, но не удаляется. Проверки на уже зарегистрированную нет (каждый раз регистрируем заново)
Файл пример №2
Изменено: bedvit - 21.12.2022 14:22:17
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
Инструменты для работы с массивами COM (VBA) - преобразование данных: регистра, строк, чисел
 
#
20.09.2022 22:20:42
Мое почтение, джентльмены!
Новые инструменты для массива.
Для массивов любого количества размерностей, типа - VARIANT.
VERSION_COM L"BedvitCOM.dll_v2.0.2.0"
VERSION_XLL L"BedvitXLL.dll_v3.2.2.0"

Преобразование происходит "на месте" (штатным инструментом VariantChangeType)
Для всех элементов массива, для которых возможны преобразования:
1.ArrayCharLowerV - преобразовать все символы строки в нижний регистр
2.ArrayCharUpperV - преобразовать все символы строки в ВЕРХНИЙ регистр
3.ArrayNumToCharV - преобразовать все данные в тип: String
4.ArrayCharToNumV - преобразовать все данные в тип: Double

Пример:
Код
Sub testArrayCharNumV()
 Dim bVBA As Object: Set bVBA = CreateObject("BedvitCOM.VBA")
 Dim p: p = Array("2", "нижний регистр", 1, "ВЕРХНИЙ РЕГИСТР", 1, 56)

bVBA.ArrayCharLowerV p
bVBA.ArrayCharUpperV p
bVBA.ArrayNumToCharV p
bVBA.ArrayCharToNumV p
 
End Sub


Скачать можно здесь.
Изменено: bedvit - 22.12.2022 17:38:29
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
Фильтрация по 2000 условий
 
#
12.09.2022 16:22:28
Цитата
New написал:
Чувствую надо Bedvit'a (Виталия) сюда подключать )P.S. А то у меня есть одна задачка, которая выполняется очень долго - удаление стоп-слов из общего списка... Общий список это 1 столбец со словами-фразами (273,000 строк), а список стоп-слов 1 столбец (2.000 строк). Макрос выполняется 3,5 минуты и меня это терзает...
Павел, если правильно понял:
Вывод списка фраз (273 000 строк), где не встречаются стоп-слова (список 2000 слов) = 11,5 секунд. Выводится примерно 271000 строк.
Файл не могу приложить, написал генератор фраз и слов.
Выкладываю код - тест.
Код
Sub TestArrayFilterVStopWord()
    Dim bVBA As Object: Set bVBA = CreateObject("BedvitCOM.VBA")
    Dim i, j, t, arrRes
    Dim testSize1 As Long: testSize1 = 273000 'строки
    Dim arrV: ReDim arrV(1 To testSize1, 1 To 1)
     
    'генерируем массив-исходник
    Cells.ClearContents
    For i = 1 To testSize1
        arrV(i, 1) = CLng(Rnd * 273000) & "Test"
    Next
    Cells(1, 1).Resize(UBound(arrV, 1), UBound(arrV, 2)) = arrV
    
    'генерируем массив условий в Excel, забираем в фильтр
    Dim arrParam: ReDim arrParam(1 To 2000, 1 To 6)
    For i = 1 To 2000
        arrParam(i, 1) = 1: arrParam(i, 3) = 1: arrParam(i, 4) = 8 + 512: arrParam(i, 5) = (i + 270000) & "T"
    Next
    Cells(1, 3).Resize(UBound(arrParam, 1), UBound(arrParam, 2)) = arrParam

    'выполняем фильтрацию по 2 тыс. условий
    t = Timer
    bVBA.ArrayFilterV arrV, arrParam, 0, arrRes 'фильтруем по первому столбцу массива (273000), НЕ содержит значения из списка(2000), выводим массив arrRes на лист(271000)
    Debug.Print Timer - t
    Cells(1, 10).Resize(UBound(arrRes, 1), UBound(arrRes, 2)) = arrRes
End Sub
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
Инструменты для работы с массивами в VBA (COM), Фильтр для массива
 
#
25.08.2022 09:33:14
Моё почтение, джентльмены!
Готов инструмент фильтрации массива с любым количеством столбцов, по любым условиям.
ArrayFilterV(VARIANT* array_in, VARIANT* array_parameters, VARIANT_BOOL array_out_index, VARIANT* array_out)
1. array_in - массив входящий (одномерный, двухмерный)
2. array_parameters - массив задаваемых параметров (6 параметров для любого столбца, можно для одного и того же, можно для разных). Количество условий не ограничено. Можно создать самому из списка, можно создать двухмерный массив и заполнить, можно забрать сразу с листа Excel.
3. array_out_index - режим вывода: 0- отфильтрованный массив, 1-массив индексов
4. array_out - массив результатов

Условия в массиве параметров применяются в том же порядке, что и везде. Приоритет скобки, потом "И" и "ИЛИ" (одинаковый приоритет, выполняются в порядке следования)
Параметры массива условий (сделал максимально просто для пользователя):
1-логические операторы (0-ИЛИ, 1-И)
2-скобка открывающая
3-столбец для фильтрации
4-операторы сравнения (//1-меньше, 2-равно, 4-больше, 8-содержит подстроку, 16-резерв(регулярки), 32- игнорировать регистр, 64-резерв(basic),  128-резерв(extended), 256 - LIKE (пока с символом подстановки "*"), 512-НЕ)
5-значение для фильтра
6-скобка закрывающая,

Условия можно задавать как простые:
'фильтр по первому столбцу, значение = 9
Array(, , 1, Равно, 9, "")


так и более сложные, к примеру выше
Array(, "(((", 1, Содержит, "маша", , ИЛИ, , 1, Содержит, "вася", ")", И, , 1, НеРавно, "маша иванова", ")", ИЛИ, "(", 2, НеРавно, "'1", , ИЛИ, , 2, Равно, 1, "))", И, "(", 3, БольшеРавно, 12.5, , И, , 3, МеньшеРавно, 55.8, ")")
или в таком виде (как удобнее)
Array( _
, "(((", 1, Содержит, "маша", , _
ИЛИ, , 1, Содержит, "вася", ")", _
И, , 1, НеРавно, "маша иванова", ")", _
ИЛИ, "(", 2, НеРавно, "'1", , _
ИЛИ, , 2, Равно, 1, "))", _
И, "(", 3, БольшеРавно, 12.5, , _
И, , 3, МеньшеРавно, 55.8, ")" _
)

ArrayFilterV поиск по 10млн. строк с найденными 5 млн. - 4 сек.
В улучшенном варианте (1 этап оптимизации) - 1,76 сек.
Оптимизированный вариант: вывод отфильтрованного массива 5 млн строк (изначальный 10 млн) = 0,25 секунд
вывод массива индексов 5 млн строк (изначальный 10 млн)  = 0,17 секунд


Простой пример (с замером скорости на 10 млн строк) и сложный (с выводом условий и результата):
Код
Option Explicit
'операторы (aliases) псевдонимы
Const ИЛИ = 0, И = 1, РАВНО = 2, СОДЕРЖИТ = 8, НЕРАВНО = 512 + 2, МЕНЬШЕРАВНО = 1 + 2, БОЛЬШЕРАВНО = 4 + 2, МЕНЬШЕ = 1, БОЛЬШЕ = 4

'ОДНОМЕРНЫЙ МАССИВ, ПРОСТЫЕ УСЛОВИЯ
Sub TestArrayFilterV_1()
    'Dim bVBA As New BedvitCOM.VBA 'раннее связывание
    Dim bVBA As Object: Set bVBA = CreateObject("BedvitCOM.VBA") 'позднее связывание
    Dim arrResult
    'первоначальный массив данных
    Dim arrV: arrV = Array(1, 0, 1, 0, 1, 0)
    'массив условий (фильтр по первому столбцу, значение = 1)
    Dim p: p = Array(, , 1, РАВНО, 1, "")

    ' фильтруем ===============================
    bVBA.ArrayFilterV arrV, p, 0, arrResult
    '========================================
    Debug.Print UBound(arrResult) + 1 'начало с 0
End Sub



'ДВУХМЕРНЫЙ МАССИВ, ПРОСТЫЕ УСЛОВИЯ
Sub TestArrayFilterV_2()
    'Dim bVBA As New BedvitCOM.VBA 'раннее связывание
    Dim bVBA As Object: Set bVBA = CreateObject("BedvitCOM.VBA") 'позднее связывание
    Dim arrResult, r, c, t, x
    Dim sizeRow As Long: sizeRow = 10000000
    Dim sizeCol As Long: sizeCol = 1
    Dim arrV: ReDim arrV(1 To sizeRow, 1 To sizeCol) 'первоначальный массив данных, далее хаполняем рендомно
    
    'массив условий (фильтр по первому столбцу, значение = 1)
    Dim p: p = Array(, , 1, РАВНО, 1, "")
    
    'заполняем первоначальный массив с данными
    For r = 1 To sizeRow
        For c = 1 To sizeCol
        arrV(r, c) = CLng(Rnd * 2)
        Next
    Next
    
    t = Timer
    ' фильтруем ===============================
    bVBA.ArrayFilterV arrV, p, 0, arrResult
    '========================================
    Debug.Print Timer - t
    Debug.Print UBound(arrResult) + 1 'начало с 0
End Sub



'ДВУХМЕРНЫЙ МАССИВ, СЛОЖНЫЕ УСЛОВИЯ
Sub TestArrayFilterV_3()

Dim arrParam, arrTest, arrRes, bCOMvba As Object: Set bCOMvba = CreateObject("BedvitCOM.VBA")

Cells.ClearContents

'создаем тестовый массив
arrTest = Array("маша иванова", "'1", 13, "маша иванова", 1, 13, "маша", "'1", 14, "вася", "'1", 14, "паша", 1, 50, "вася", 2, 52, "маша", 1, 60, "вася", 1, 65)
bCOMvba.Array1Dto2D arrTest, 1, 1, UBound(arrTest) / 3: bCOMvba.Transpose arrTest
Cells(1, 1).Resize(UBound(arrTest, 1), UBound(arrTest, 2)) = arrTest

'запись условий для фильтра:(((c1 like "маша" or like "вася") and c1<>"маша иванова") or (c2<>"1" or c2=1)) and (c3>=12,5 and c3<=55,8)
arrParam = Array(, "(((", 1, СОДЕРЖИТ, "маша", , ИЛИ, , 1, СОДЕРЖИТ, "вася", ")", И, , 1, НЕРАВНО, "маша иванова", ")", ИЛИ, "(", 2, НЕРАВНО, "'1", , ИЛИ, , 2, РАВНО, 1, "))", И, "(", 3, БОЛЬШЕРАВНО, 12.5, , И, , 3, МЕНЬШЕРАВНО, 55.8, ")")
'ИЛИ ТАК
arrParam = Array( _
, "(((", 1, СОДЕРЖИТ, "маша", , _
ИЛИ, , 1, СОДЕРЖИТ, "вася", ")", _
И, , 1, НЕРАВНО, "маша иванова", ")", _
ИЛИ, "(", 2, НЕРАВНО, "'1", , _
ИЛИ, , 2, РАВНО, 1, "))", _
И, "(", 3, БОЛЬШЕРАВНО, 12.5, , _
И, , 3, МЕНЬШЕРАВНО, 55.8, ")" _
)
bCOMvba.Array1Dto2D arrParam, 1, 1, UBound(arrParam) / 6: bCOMvba.Transpose arrParam
Cells(1, 5).Resize(UBound(arrParam, 1), UBound(arrParam, 2)) = arrParam

'применяем фильтр
bCOMvba.ArrayFilterV arrTest, arrParam, 0, arrRes
Cells(1, 12).Resize(UBound(arrRes, 1), UBound(arrRes, 2)) = arrRes

End Sub



Выложил описание и релизы библиотек на сайт.
Изменено: bedvit - 21.09.2022 11:24:11
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
Не работает инструмент "Вставить видео" в панели сообщений
 
#
15.04.2022 13:45:06
Ранее работал.
Пример.
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
XLL хранение и выполнение VBA кода, или защита VBA кода от просмотра?
 
#
23.02.2022 21:39:50
Мое почтение, джентльмены...
Делал для себя инструмент позволяющий хранить уже наработанный VBA код и его исполнять из XLL.
Но тут случился Омикрон и проснулся сумрачный гений или случился сон разума... скорее второе...
Сон прошел, но вот что осталось...
Своим VBA-решением можно поделится с коллегами. Они смогут его использовать, но не смогут посмотреть код.
Функционал:
+Создана форма для загрузки и выполнения загруженного VBA-кода (загружаемый код - с Option Explicit и другими операторами).
+Можно запускать прямо с главной панели (выбрав из списка нужный)
+Можно задавать пароль на просмотр (по умолчанию это слово "Пароль")
+Можно смотреть VBA-код, если знаешь пароль.
+Можно выполнять VBA-код, даже если не знаешь пароль.
+Код хранится зашифрованный в файле сохранения настроек библиотеки (BedvitXLL.bin).
+Пароль не хранится, а хранится его хеш
+VBA-код может загрузить любой пользователь и любой пользователь его использовать, при условии включенного доступа к объектной модели проектов VBA.
-пока работает только один модуль VBA
-выполняется только Sub() без аргументов, или с аргументами по умолчанию в качестве стартовой процедуры. В самом коде нет ограничений. Просто вызов с кнопки, аргументы сейчас не передаются. Но доработать можно при наличии интереса.
-нельзя использовать Function(), другими словами UDF.
-функционал скромный, обрисовал только концепцию (на большее просто нет времени)
-кнопка "сохранить в файл" для сохранения кода в формате С++(доп.функционал для автора, для пользователя не нужная), все настройки сохраняются автоматически при загрузке.


Скачать сокращенную версию BedvitXLL(v3.0.0.1)
или Полную последнюю версию на сайте

В библиотеки предзагруженный тестовый код с паролем по умолчанию (можно посмотреть - кнопка "показать код")

Кому интересно, прошу протестировать.
Автору так же интересен момент, есть ли дыры в защите.
Пишите, заделаем бреши, если они есть (проект создан чисто из спортивного интереса)
Изменено: bedvit - 10.04.2022 17:19:00
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
Программное заведение пароля на проект VBA
 
#
01.02.2022 22:36:37
Мое почтение, джентльмены.
Не могу разобрать почему все работает если сохранить и закрыть файл вручную и не работает если сделать программно (раскомментировать две последних строки)?
Excel 2013 x64, Win10
Код
Sub TestPasswordProject()
With ThisWorkbook.Application
.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
.SendKeys "^{TAB}"
.SendKeys "{ }"
.SendKeys "{TAB}" & 1
.SendKeys "{TAB}" & 1
.SendKeys "{TAB}"
.SendKeys "{ENTER}"
End With
'ThisWorkbook.Save ' при ручном сохранении и закрытии файла все сохраняется, программно - нет.
'ThisWorkbook.Close 0
End Sub
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
Сбросить счётчик форматов ячеек не переоткрывая файл., "Слишком много различных форматов ячейки"
 
#
10.12.2021 10:43:49
Всем привет!
Файл с количеством форматов более 64 тыс. (заполняются динамически)
Получаю сообщение "Слишком много различных форматов ячейки."
Удаляю все форматы, сообщение не пропадает.
Если файл сохранить и открыть заново, сообщение не выводится.
Как сбросить счетчик форматов ячеек, не переоткрывая файл?
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
Статистика по выделенному диапазону: Типы данных, дубликаты, повторы, уникальные и т.д.
 
#
10.12.2021 00:02:24
Мое почтение, джентльмены!
Дошли руки, доделал инструмент, теперь уже не только окраски всех повторов и поиска дубликатов, но и более подробной статистики по данным в диапазоне (в т.ч. и по типам данных, которые есть в диапазоне), см. скрин.

Кнопка "Дубликаты"
Работает шустро, библиотеку залил на сайт. Кому интересно прошу протестировать и дать обратную связь.
Если будет годный инструмент, можно сделать реализацию под использование в VBA.
Изменено: bedvit - 30.01.2022 21:37:02
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
Аналог функции DAX: CONCATENATEX() для Excel 2013
 
#
31.08.2021 10:12:33
Всем привет!
Возможно ли создать формулу-аналог функции DAX: CONCATENATEX() для Excel 2013?
т.к. CONCATENATEX() появился только в  Excel 2016.

Цель: сцепить строки по группам, в которых они находятся.
Изменено: bedvit - 31.08.2021 10:35:14
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
ВПР() на DAX
 
#
25.08.2021 22:42:14
Мое почтение, джентльмены.
Как написать на DAX формулу для третьего столбца?
Аналог ВПР() Excel.
Пример в файле и скрин на рис
Изменено: bedvit - 25.08.2021 22:42:34
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
Быстрое преобразование массива из одномерного в двухмерный и наоборот с сохранением всех данных (BedvitCOM v1.0.5.0 и выше)
 
#
06.08.2021 14:01:22
Мое почтение, джентльмены.
Появился следующий функционал, делюсь.
Функции:
1.Array2Dto1D() - быстрое преобразования двухмерного массива в одномерный (данные не обрезаются, 2е измерение преобразуются в очередь) (v1.0.5.0 и выше)
Параметры метода:
1.array_in_out - массив, который нужно преобразовать
2.lLbound1 - нижняя граница нового массива (по умолчанию=0)

2.Array1Dto2D() - быстрое преобразование одномерного массива в двухмерный (данные не удаляются) (v1.0.5.0 и выше)
Параметры метода:
1.array_in_out - массив, который нужно преобразовать
2.lLbound1 - нижняя граница нового массива, 1е измерение (по умолчанию=0)
3.lLbound2 - нижняя граница нового массива, 2е измерение (по умолчанию=0)
4.cElements1 [/B ] - размер, первой размерности - кол-во столбцов (по умолчанию=1). Вторая рассчитывается автоматически (начиная с v2.0.0.2).
Размер для размерности должен задаваться так, что бы общее количество элементов массива было кратно задаваемому размеру

Использование:
Код
Sub TestArrayDtoD()
Dim r As BedvitCOM.VBA: Set r = New BedvitCOM.VBA 'раннее связывание
Dim t, arr, i
arr = [a1:a1000000]
t = Timer
For i = 1 To 1000000
    r.Array2Dto1D arr 'в одномерный (нижняя граница = 0 - по умолчанию)
    r.Array1Dto2D arr, 1, 1 'в двухмерный с 1м столбцом, нижние границы измерений = 1
Next
Debug.Print "bVBA.ReDimArray: " & Timer - t & " sec."
End Sub


Результат:
Преобразование массива из [B]1 млн строк из двухмерного в одномерный и наоборот 1 млн. раз = 0,1210938 sec.

начиная с v2.0.0.2
Код
Sub TestArrayDtoD_()
    'Dim bVBA As New BedvitCOM.VBA 'раннее связывание
    Dim bVBA As Object: Set bVBA = CreateObject("BedvitCOM.VBA") 'позднее связывание
    Dim arr
    arr = [a1:b10] ' забираем массив 2 столбца, 10 строк
    bVBA.Array2Dto1D arr 'в одномерный (нижняя граница = 0 - по умолчанию)
    bVBA.Array1Dto2D arr, 1, 1, 10 'преобразуем в двухмерный с 10ю столбцами и 2 строками, нижние границы измерений = 1, порядок данных сохраняется исходный
    Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)) = arr 'нового размера массив со старым порядком данных
End Sub
Изменено: bedvit - 29.08.2022 14:03:24
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
std::unordered_map в VBA. Быстрая замена словарям и коллекциям, быстрая замена словарям и коллекциям
 
#
27.05.2021 17:13:37
Мое почтение, джентльмены.
Родилась идея завернуть один из стандартных контейнеров С++ (std::unordered_map) в СОМ (для возможности пользоваться и из VBA)
Идея понравилась и реализована (часть методов будет добавлена при необходимости).
Особенности:
-ключ и значение сейчас реализованы как String теперь можно использовать любые данные в качестве ключа и значения
-это хеш-таблица, а поэтому: поиск, вставка и удаление элементов имеют среднюю постоянную сложность.
-стабильно быстрее в разы/порядки Collection и Dictionary
-ВАЖНО! сейчас реализовано сохранения данных в контейнере до момента закрытия библиотеки (xll), т.е. выполнив процедуру в модуле, при выполнении следующей процедуру - данные в контейнере останутся. Это позволяет хранить данные (к примеру, как на листе). Если нужен чистый контейнер, просто очищаем когда нужно.
Новая реализация позволяет создавать любое количество хеш-таблиц и автоматом удаляет их при завершении работы процедуры/функции

Test_Collection_vs_Dictionary_vs_UnorderedMap
Скрытый текст

Результаты на 1 млн строк, с 1 млн итераций:

Внесение данных, Collection.Add = 13,09766
Внесение данных, Dictionary.Add = 73,87109
Внесение данных, U.TryEmplace = 0,9726563
Поиск верных данных, Collection.Item = 4,703125
Поиск верных данных, Dictionary.Item = 72,79688
Поиск данных, U.Find = 0,8007813
Итого элементов в UnorderedMap 1000000

Как использовать?
-Так же как и словарь или коллекцию
Код
Sub UnorderedMap()
Dim U As New BedvitCOM.UnorderedMap ': Set r = New BedvitCOM.VBA 'раннее связывание
Dim key, value, value2, sizeU, x

key = "key"
value = "value"
If (U.Insert(key, value) = 0) Then MsgBox "Элемент уже существует и не был обновлен"
If (U.InsertOrAssign(key, value) = 0) Then MsgBox " = 0 - Элемент обновлен" 'если = 1 то создан новый
Debug.Print U.Size 'количество элементов контейнера
If (U.Find(key, value2) = 0) Then MsgBox "Не удалось найти элемент"
Debug.Print value2 'выводим найденный результат по ключу
If (U.Erase(key) = 0) Then MsgBox "Не удалось удалить элемент" 'очистка элемента по ключу
Debug.Print U.Size
U.Clear 'очистить весь контейнер

End Sub

Если будет интерес - будем развивать проект.

Ссылка на beta-версию.
Изменено: bedvit - 01.06.2021 18:04:29
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
C API Excel for VBA, Используем в VBA - C API функционал Excel
 
#
20.04.2021 12:49:51
Открою новый  блок: Функционал C API Excel для VBA.
Напрямую использовать не предусмотрено, поэтому буду делать функции-обертки.
Что это дает и зачем это нужно?
Дает кратный прирост скорости (в некоторых случаях).
Нужно для максимальной производительности кода в Excel, использую не самый быстрый VBA.
Минусы:
-Определенные ограничения самого C API Excel
-Нужна XLL (можно напилить самому или использовать стороннюю с таким функционалом)
-Нужно время спеца (который будет этим заниматься) для подготовки функций-оберток

Будет интерес и время - посмотрим, что из этого может получится.

В качестве тестового примера реализовал функцию поиска на листе нужных данных.
Функция: FindValuesXLL
Аргументы (см.ниже код):
1.Нужный диапазон - Range ( у меня выделенное - Selection, можно любой Range, в т.ч. и несколько Areas)
2.Искомое значение (может быть и числом и текстом)
3.Параметр сравнения (1 -меньше искомого значения, 2 - равно, 4 - больше, 8 - содержит (для строк))
параметры можно смешивать через OR (к примеру "1 or 2" ).
Можно будет добавить еще параметров сравнения, при взаимном интересе к теме.
Возвращаемый результат: Range (до 32767 Areas, см. ниже особенности)
Особенности:
>Сейчас реализован результат - как максимальный стек из 32767 Areas, т.е. будет найдено не более 32767 отдельно стоящих прямоугольников (в прямоугольнике может быть любое количество ячеек). Если будет нужно больше  - можно рассмотреть.
>Функция автоматически объединяет соседние по вертикали блоки в один (оптимизация по количеству Areas)
>Строки сравниваются с учетом регистра. Есть возможность сделать без учета, если будет интерес.
Код
Sub test()
Dim x
Set x = Run("FindValuesXLL", Selection, 1500, 1)
x.Select
End Sub


Результат поиска на примере одного из быстрейших вариантов на VBA
Всего ячеек - 170 000
Найдено отдельно стоящих ячеек -127 450

PRDX time total:         2,703 sec
FindValuesXLL:           0,020 sec

Итого разница боле чем в 100 раз.

Прошу тестировать: скачать xll, открыть или установить с помощью установщика или самому, написать нужный код в VBA.
Изменено: bedvit - 20.04.2021 13:00:08
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
Решения задач комбинаторики. XLAM or XLL (VBA or C++)
 
#
04.12.2020 13:49:18
Мое почтение, джентльмены.
Хочу понять будет ли профит и какой.
Давайте для начала рассмотрим какое либо простое решение на VBA, что бы я переложил в XLL и сравним результаты.
Если результат порадует, можно будет переложить в XLL что-то нужное для всех. Будет копилочка быстрых решений для форума (если будет время и интерес).
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
GUI в XLL, Рассмотрим возможные варианты
 
#
19.11.2020 19:03:23
Наконец добрался до возможности взаимодействия xll с пользователем посредством графического интерфейса.
И здесь, к сожалению вариантов мало и все они мало где освещены.
Информацию по биту доставал.
C VBA все отлично, там элементарно делается Ribbon на XML и вперед.
в xll на С++ так не сделать.
Рассматривал такие варианты:
1. Программное создание меню через Excel C++ API (добавляются команды на вкладку "ADD-IN")
2. Создание на чистом С++ COМ-интерфейса и использование СОМ-модели Excel для создания панели (программно). Похож на первый вариант, но можно добавлять иконки.
3. Создание Ribbon XML через управляемый код и интегрировать это все в xll (собственно это и есть Ribbon как в VBA, но прослойка из управляемого кода еще тот торт)

Начал с первого варианта.
Версия v1.0.3.3beta
Какое окошко вам больше нравится?
WIN API, с диалогом перехода на сайт
Или Excel API, со справкой (перехода на сайт)
Также будет транспонирование массива на месте, пока только вывод тестовых данных сделал.

Если есть инфо по теме, буду рад изучить.

Что использовал:
Раз
Два
Три
Изменено: bedvit - 19.11.2020 19:14:54
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
Визуально разные по ширине столбцы, при одинаковой указанной ширине в разных файлах Excel
 
#
11.11.2020 11:13:55
Мое почтение, джентльмены.
Визуально разные по ширине столбцы, при одинаковой указанной ширине (14 пунктов) в прилагаемых 2х файлах.
Ширина столбца (14 пунктов), шрифт, масштаб одинаковые.
Что упустил?
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
OfficeEvents
 
#
06.08.2020 11:03:23
Мое почтение, джентльмены.
Попросил Excel (отдельно Word) поделится событиями.
Некоторые события обозначил, некоторые закодированы первоначальным кодом.
У всех работает?
Нужно запустить exe при открытом Excel, далее Excel сохранить, потыкать, закрыть, посмотреть данные в консоли.
.exe мой, диск не форматирует :)
Присоединяется к первому процессу.
Изменено: bedvit - 06.08.2020 11:10:00
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
Удалить в диспетчере имен некорректные имена кодом VBA, имена содержащие ошибку #ИМЯ?
 
#
27.03.2020 14:57:36
Ручками удаляет, кодом нет.
Файл-пример с кодом прилагаю.
Как красиво победить?
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
OCR в VBA: распознавание текста с картинки
 
#
02.03.2020 17:13:24
Всем привет!
Нужно распознать простой текст по ссылке.
Кто чем пользуется?
Статью Игоря читал - не взлетает такое решение.
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
Количество цветов в произвольном диапазоне R+G+B
 
#
27.02.2020 12:11:27
Всем привет!
Ноги здесь
Задача проста:
Сколько цветов RGB будет в произвольно задаваемом диапазоне (к примеру 500-700), если этот диапазон получен сложением  R+G+B? Как вывести результат математически?

Полный диапазон 0(0+0+0) - 765(255+255+255)
Сначала я сделал неверное предположение, что это 200^3 = 8 млн.
Далее, просто набросал код:
Код
Sub run()
Debug.Print count(500, 700) '0-765
End Sub
Function count(iMin As Long, iMax As Long) As Long
Dim R As Long, G As Long, B As Long
For R = 0 To 255 Step 1
    For G = 0 To 255 Step 1
        For B = 0 To 255 Step 1
            If R + G + B >= iMin And R + G + B <= iMax Then count = count + 1
        Next
    Next
Next
End Function

Вышло - 3 123 751 цветов.

Понял, что это комбинаторика и набросал еще код, раскладывающий количество цветов на каждую единицу данного диапазона (0-765).
Код
Sub run()
Dim i As Long
For i = 0 To 765
    Cells(i + 1, 1) = count(i, i)
Next
End Sub
Function count(iMin As Long, iMax As Long) As Long
Dim R As Long, G As Long, B As Long
For R = 0 To 255 Step 1
    For G = 0 To 255 Step 1
        For B = 0 To 255 Step 1
            If R + G + B >= iMin And R + G + B <= iMax Then count = count + 1
        Next
    Next
Next
End Function

Результат в файле.
Какой математической функцией можно получить данный результат?

P.S.
Все знают, но здесь оставлю, что принимает Color и как работает функция RGB()
Excel.Color = RGB(R*256^0+G*256^1+B*256^2), диапазон 0-(256^3-1)
Изменено: bedvit - 27.02.2020 12:13:11
«Бритва Оккама» или «Принцип Калашникова»?
 
Перейти    
Страницы: 1 2 3 След.
Наверх