Функция/Метод 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
Мое почтение, джентльмены! В продолжении темы 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:
Мое почтение, джентльмены! 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, для оптимизации размера одинаковых строк.
Мое почтение, джентльмены! т.к. в С/С++ нет 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
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)
Поддержка следующих алгоритмов : 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"
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
Моё почтение, джентльмены! Продолжение темы Инструменты для работы с массивами 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
Моё почтение, джентльмены! 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
Код открыт (С/С++), выкладываю ниже, на случай, если у кого-то будут идеи по оптимизации
Скрытый текст
Код
STDMETHODIMP CVBA::ReDimPreserve2D(VARIANT* array_in_out, LONG lLbound0, LONG cElements0, LONG lLbound1, LONG cElements1)//какой порядок хотим, сейчас столбцы, строки
{
if (!(array_in_out->vt & VT_ARRAY)) { return E_INVALIDARG; } //если VARIANT НЕ содержит SAFEARRAY
if (array_in_out->parray->cDims!=2) { return E_INVALIDARG; } //если массив не двумерный
if (cElements0<1 || cElements1<1) { return E_INVALIDARG; } //если количество элементов в размерности меньше 1
HRESULT hr=0;
size_t cElements0In = array_in_out->parray->rgsabound[0].cElements; //количество элементов 1х массив/2х массив - столбцов
size_t cElements1In = array_in_out->parray->rgsabound[1].cElements; //количество элементов 2х массив - строк
if(cElements0==cElements0In && cElements1==cElements1In){//если размер массива не меняется, меняем только нижние границы
char HUGEP* arrIn; //в с-массив
if ((hr = SafeArrayAccessData(array_in_out->parray, (void HUGEP**)&arrIn))) { return hr; } //Увеличивает счетчик блокировок массива и извлекает указатель на данные массива.
array_in_out->parray->rgsabound[0].lLbound = lLbound0;
array_in_out->parray->rgsabound[1].lLbound = lLbound1;
if ((hr = SafeArrayUnaccessData(array_in_out->parray))) { return hr; } //Увеличивает счетчик блокировок массива и помещает указатель на данные массива в pvData дескриптора массива.
return S_OK;
}
VARTYPE pvt=0;
if(SafeArrayGetVartype(array_in_out->parray,&pvt)){ return E_INVALIDARG; } //если не удалось узнать тип массива
size_t elemSize = SafeArrayGetElemsize(array_in_out->parray); //размер элемента массива в байтах
//CComSafeArray<VARIANT> safeArrV;
CComSafeArrayBound rgsabound[2];
rgsabound[0].SetLowerBound(lLbound1);//нижняя граница массива - строки (наоборот от входящего массива?)
rgsabound[0].SetCount(cElements1);//строки
rgsabound[1].SetLowerBound(lLbound0);//нижняя граница массива - столбцы
rgsabound[1].SetCount(cElements0);//столбцы
//if (safeArrV.Create(bound, 2)) { return E_INVALIDARG; }//Указатель на объект SAFEARRAYBOUND, исло измерений в массиве.
SAFEARRAY * safeArr = SafeArrayCreate(pvt, 2, rgsabound);
long cElements0Min = cElements0 > cElements0In ? cElements0In : cElements0;//заполняемый массив - столбцов
long cElements1Min = cElements1 > cElements1In ? cElements1In : cElements1;//заполняемый массив - строк
size_t rowsSize=elemSize *cElements1Min;//итоговый размер строк в байтах
long difElements1In= (cElements1In - cElements1Min)*elemSize+ rowsSize;//разница между количеством байт строк входящего массива и заполняемого
long difElements1= (cElements1 - cElements1Min)*elemSize+ rowsSize; //разница между количеством байт строк исходящего массива и заполняемого
char HUGEP* arrIn; //в с-массив
char HUGEP* arrOut; //в с-массив
if ((hr = SafeArrayAccessData(array_in_out->parray, (void HUGEP**)&arrIn))) { return hr; } //Увеличивает счетчик блокировок массива и извлекает указатель на данные массива.
if ((hr = SafeArrayAccessData(safeArr, (void HUGEP**)&arrOut))) { SafeArrayUnaccessData(array_in_out->parray); return hr; } //Увеличивает счетчик блокировок массива и извлекает указатель на данные массива.
//код переноса кусков сторого массива в новый, в зависимости от размеров нового и старого и размера элемента
if (cElements1 == cElements1In) {//если меняем только последнюю размерность - количество столбцов
memcpy(arrOut, arrIn, rowsSize*cElements0Min); //заполняем массив куском строк из другого массива
SecureZeroMemory(arrIn, rowsSize*cElements0Min); //заполняем нулями скопированный ранее участок памяти, что бы SafeArrayDestroy не почистил скопированные строки по оставшимся указателям
}
else {//если меняем и количество строк
char* arrTmpIn = arrIn;
char* arrTmpOut = arrOut;
for (long i = 0; i < cElements0Min; i++) {//перебор по столбцам и копируем всю строку сразу (мин)
memcpy(arrTmpOut, arrTmpIn, rowsSize); //заполняем массив куском строк из другого массива
SecureZeroMemory(arrTmpIn, rowsSize); //заполняем нулями скопированный ранее участок памяти, что бы SafeArrayDestroy не почистил скопированные строки по оставшимся указателям
//перемещение двух указателей на след.блок памяти, который нужно скопировать
arrTmpIn += difElements1In;
arrTmpOut += difElements1;
}
}
if ((hr = SafeArrayUnaccessData(safeArr))) { SafeArrayUnaccessData(array_in_out->parray); return hr; } //Уменьшает количество блокировок массива и делает недействительным указатель, полученный SafeArrayAccessData .
if ((hr = SafeArrayUnaccessData(array_in_out->parray))) { return hr; } //Уменьшает количество блокировок массива и делает недействительным указатель, полученный SafeArrayAccessData .
SafeArrayDestroy(array_in_out->parray);
array_in_out->parray = safeArr;//safeArrV.Detach();
return S_OK;
}
Пока не знаю, будет ли отдельный проект по автоматизации для 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 условиям. Пока вся сложность в массивах.
В общем-то ничего сложного: добавляем в ресурсы листа Excel (там же и код) и вызываем по мере необходимости. Сделал простой пример, весь функционал в одном листе (код и ресурсы - упакованные библиотеки) Вообще, способов есть несколько. Был и второй, через класс - класс в деструкторе сам отключает библиотеку при завершении программы, но нужно переносить модуль класса, а в первом варианте только код листа "ByteSheet" Автоматическое подключение BedvitCOM.dll, без использования BedvitXLL (если будет интересно могу сделать пример/тему и для BedvitXLL). т.е. незаметно для пользователя, без лишних меню и без прав администратора (все под пользователем, и BedvitXLL, кстати так же работает и распаковывает BedvitCOM) Антивирусы не любят такую упаковку в VBA, да и вообще VBA
Как испрльзовать: 1. Загрузить, удалить (обновить) библиотеки BedvitCOM32, BedvitCOM64 можно с помощью команды Start_Menu на листе ByteSheet. Этот лист нужен для хранения этих библиотек. Это единственное что нужно перенести в ваш проект, лист с кодом, всё. 2. Для раннего связывания нужно запускать интциализацию библиотеки в отдельной процедуре (см. код в кнопке). Для позднего можно все в одной. 3. Любой код можно писать в процедуре test и любых других, включив их в первоначальный код, где происходит инициализация.Это нужно для раннего связывания. Для позднего можно делать инициализацию библиотеки прямо в своем коде. Но прошу помнить, что жто время. Для увеличения быстродействия, библу лучше подключать один раз на весь период расчета. Не в каждой выполняемой фкнкции включать/выключать.
Собственно всё просто.
bedvit 2022.12.21 - Новый установщик Механизм регистрации BedvitCOM v2 упрощенный (без вызова Regsvr32), позднее связывание (не нужен доступ к объектной модели VBA) BedvitCOM регистрируется, но не удаляется. Проверки на уже зарегистрированную нет (каждый раз регистрируем заново) Файл пример №2
Мое почтение, джентльмены! Новые инструменты для массива. Для массивов любого количества размерностей, типа - 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
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
Моё почтение, джентльмены! Готов инструмент фильтрации массива с любым количеством столбцов, по любым условиям. 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
Мое почтение, джентльмены... Делал для себя инструмент позволяющий хранить уже наработанный VBA код и его исполнять из XLL. Но тут случился Омикрон и проснулся сумрачный гений или случился сон разума... скорее второе... Сон прошел, но вот что осталось... Своим VBA-решением можно поделится с коллегами. Они смогут его использовать, но не смогут посмотреть код. Функционал: +Создана форма для загрузки и выполнения загруженного VBA-кода (загружаемый код - с Option Explicit и другими операторами). +Можно запускать прямо с главной панели (выбрав из списка нужный) +Можно задавать пароль на просмотр (по умолчанию это слово "Пароль") +Можно смотреть VBA-код, если знаешь пароль. +Можно выполнять VBA-код, даже если не знаешь пароль. +Код хранится зашифрованный в файле сохранения настроек библиотеки (BedvitXLL.bin). +Пароль не хранится, а хранится его хеш +VBA-код может загрузить любой пользователь и любой пользователь его использовать, при условии включенного доступа к объектной модели проектов VBA. -пока работает только один модуль VBA -выполняется только Sub() без аргументов, или с аргументами по умолчанию в качестве стартовой процедуры. В самом коде нет ограничений. Просто вызов с кнопки, аргументы сейчас не передаются. Но доработать можно при наличии интереса. -нельзя использовать Function(), другими словами UDF. -функционал скромный, обрисовал только концепцию (на большее просто нет времени) -кнопка "сохранить в файл" для сохранения кода в формате С++(доп.функционал для автора, для пользователя не нужная), все настройки сохраняются автоматически при загрузке.
В библиотеки предзагруженный тестовый код с паролем по умолчанию (можно посмотреть - кнопка "показать код")
Кому интересно, прошу протестировать. Автору так же интересен момент, есть ли дыры в защите. Пишите, заделаем бреши, если они есть (проект создан чисто из спортивного интереса)
Мое почтение, джентльмены. Не могу разобрать почему все работает если сохранить и закрыть файл вручную и не работает если сделать программно (раскомментировать две последних строки)? 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
Всем привет! Файл с количеством форматов более 64 тыс. (заполняются динамически) Получаю сообщение "Слишком много различных форматов ячейки." Удаляю все форматы, сообщение не пропадает. Если файл сохранить и открыть заново, сообщение не выводится. Как сбросить счетчик форматов ячеек, не переоткрывая файл?
Мое почтение, джентльмены! Дошли руки, доделал инструмент, теперь уже не только окраски всех повторов и поиска дубликатов, но и более подробной статистики по данным в диапазоне (в т.ч. и по типам данных, которые есть в диапазоне), см. скрин.
Кнопка "Дубликаты" Работает шустро, библиотеку залил на сайт. Кому интересно прошу протестировать и дать обратную связь. Если будет годный инструмент, можно сделать реализацию под использование в VBA.
Всем привет! Возможно ли создать формулу-аналог функции DAX: CONCATENATEX() для Excel 2013? т.к. CONCATENATEX() появился только в Excel 2016. Цель: сцепить строки по группам, в которых они находятся.
Мое почтение, джентльмены. Появился следующий функционал, делюсь. Функции: 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
Мое почтение, джентльмены. Родилась идея завернуть один из стандартных контейнеров С++ (std::unordered_map) в СОМ (для возможности пользоваться и из VBA) Идея понравилась и реализована (часть методов будет добавлена при необходимости). Особенности: -ключ и значение сейчас реализованы как String теперь можно использовать любые данные в качестве ключа и значения -это хеш-таблица, а поэтому: поиск, вставка и удаление элементов имеют среднюю постоянную сложность. -стабильно быстрее в разы/порядки Collection и Dictionary -ВАЖНО! сейчас реализовано сохранения данных в контейнере до момента закрытия библиотеки (xll), т.е. выполнив процедуру в модуле, при выполнении следующей процедуру - данные в контейнере останутся. Это позволяет хранить данные (к примеру, как на листе). Если нужен чистый контейнер, просто очищаем когда нужно. Новая реализация позволяет создавать любое количество хеш-таблиц и автоматом удаляет их при завершении работы процедуры/функции
Test_Collection_vs_Dictionary_vs_UnorderedMap
Скрытый текст
Код
Sub Test_Collection_vs_Dictionary_vs_UnorderedMap() ' - что быстрее словарь или коллекция
Dim t, y, arr(1000000, 1) As String, i As Long, x As Long, xEnd As Long, FileTemp As String, value2
Dim coll As Collection: Set coll = New Collection
Dim Dict: Set Dict = CreateObject("Scripting.Dictionary")
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim U: Set U = CreateObject("BedvitCOM.UnorderedMap")
'Dim U As New BedvitCOM.UnorderedMap ': Set r = New BedvitCOM.VBA 'раннее связывание
xEnd = 1000000 'количество итераций
For x = 1 To xEnd 'МАССИВ для проверки
arr(x, 0) = x
arr(x, 1) = "\\0.0.0.0\work$\05_КД\05-04_КС\КАТАЛОГИ\тест\0009613%01-С8-01.jpg" & x
Next
t = Timer
For x = 1 To xEnd 'добавляем элементы
coll.Add arr(x, 0), arr(x, 1)
Next
Debug.Print "Внесение данных, Collection.Add = " & Timer - t
t = Timer
For x = 1 To xEnd 'добавляем элементы
Dict.Add arr(x, 1), arr(x, 0)
Next
Debug.Print "Внесение данных, Dictionary.Add = " & Timer - t
t = Timer
For x = 1 To xEnd 'добавляем существующие элементы
y = U.TryEmplace(arr(x, 0), arr(x, 1))
Next
Debug.Print "Внесение данных, U.TryEmplace = " & Timer - t
Debug.Print "Итого элементов в UnorderedMap " & U.Size 'количество элементов контейнера
t = Timer
For x = 1 To xEnd 'ищем существующие элементы
y = coll.Item(arr(x, 1))
Next
Debug.Print "Поиск верных данных, Collection.Item = " & Timer - t
t = Timer
For x = 1 To xEnd 'ищем существующие элементы
y = Dict.Item(arr(x, 1))
Next
Debug.Print "Поиск верных данных, Dictionary.Item = " & Timer - t
t = Timer
For x = 1 To xEnd 'ищем существующие элементы
U.Find arr(x, 1), value2
Next
Debug.Print "Поиск данных, U.Find = " & Timer - t
End Sub
Результаты на 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
Открою новый блок: Функционал 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.
Мое почтение, джентльмены. Хочу понять будет ли профит и какой. Давайте для начала рассмотрим какое либо простое решение на VBA, что бы я переложил в XLL и сравним результаты. Если результат порадует, можно будет переложить в XLL что-то нужное для всех. Будет копилочка быстрых решений для форума (если будет время и интерес).
Наконец добрался до возможности взаимодействия 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, со справкой (перехода на сайт) Также будет транспонирование массива на месте, пока только вывод тестовых данных сделал.
Мое почтение, джентльмены. Визуально разные по ширине столбцы, при одинаковой указанной ширине (14 пунктов) в прилагаемых 2х файлах. Ширина столбца (14 пунктов), шрифт, масштаб одинаковые. Что упустил?
Мое почтение, джентльмены. Попросил Excel (отдельно Word) поделится событиями. Некоторые события обозначил, некоторые закодированы первоначальным кодом. У всех работает? Нужно запустить exe при открытом Excel, далее Excel сохранить, потыкать, закрыть, посмотреть данные в консоли. .exe мой, диск не форматирует :) Присоединяется к первому процессу.
Всем привет! Ноги здесь Задача проста: Сколько цветов 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)