Моё почтение, джентльмены! 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;
}
в архиве 3 файла и ещё один архив BedvitXLLv2 со своим набором файлов. Вот и зачем так делать? К чему двусмысленность? Что брать? Если у тебя архив "на все случаи жизни" лежит, то почему не сообщить, что нужно из него взять, чтобы протестировать данное решение?…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
20/12/2022 BedvitXLL v4.4 beta ReDimPreserve2D() переименован в ArrayReDim2D() Добавлена новая функция ArrayReDim() Новый функционал отличается бОльшей универсальность, возможностью изменять как начало так и конец размерностей (поддерживается одномерные и двумерные массивы)
Хотел отсечь половину, но получаю ошибку. Что не так?
Код
Option Base 1
Option Explicit
Option Private Module
'==================================================================================================
Private Sub Test_ArrayDtoD_1D()
Dim x, arr, aArrs()
Dim t!, t2!, r&, n&
Const nVal& = 1000000, nCyc& = 10
ReDim arr(nVal)
t = Timer
For r = 1 To UBound(arr)
arr(r) = "_" & Format$(r, "0000000")
Next r
Debug.Print Format$(Timer - t, "0.00"), "Fill 1D" ' 0.59
ReDim aArrs(nCyc)
t = Timer
For n = 1 To nCyc
aArrs(n) = arr
Next n
Debug.Print Format$(Timer - t, "0.00"), "Fill aArrs" ' 0.75
t = Timer
For n = 1 To nCyc
bV.ArrayDtoD aArrs(n)
Next n
Debug.Print Format$(Timer - t, "0.00"), "LBound 0", LBound(aArrs(1)), UBound(aArrs(1)) ' 0.00
t = Timer
For n = 1 To nCyc
bV.ArrayDtoD aArrs(n), 1
Next n
Debug.Print Format$(Timer - t, "0.00"), "LBound 1", LBound(aArrs(1)), UBound(aArrs(1)) ' 0.00
t = Timer
For n = 1 To nCyc
bV.ArrayDtoD aArrs(n), 1, nVal / 2
Next n
Debug.Print Format$(Timer - t, "0.00"), "LBound 1", LBound(aArrs(1)), UBound(aArrs(1)) ' RunTime Error 5. Invalid call procrdure
End Sub
'==================================================================================================
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
не понял А зачем тогда cElements? Опиши инструмент подробнее, пожалуйста… А так работает быстро - для изменения нижней границы одномерного массива отлично подходит. Двумерный сейчас протестирую.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
В первом сообщении жирным: 2)Новый инструмент: преобразование размерности и нижних границ без изменения и порядка данных (в рамках всего массива) т.е. если тебе из двухмерного надо сделать одномерный с теми же данными (всеми, данные не удаляются). Или наоборот. Количество элементов нужно, если ты из одномерного хочешь сделать двумерный, указываешь размер измерений
bedvit: Количество элементов нужно, если ты из одномерного хочешь сделать двумерный, указываешь размер измерений
довольно неочевидно. Добавь в описание. Плюс, укажи ограничения, ведь я так понимаю, что там не абы как можно количество элементов назначать. Добавь и примеры небольшие.
Тест
Код
Option Base 1
Option Explicit
Option Private Module
'==================================================================================================
Private Sub Test_ArrayDtoD_1D()
Dim x, arr, aArrs()
Dim t!, t2!, r&, c&, n&
Const nVal& = 1000000, nCyc& = 10
ReDim arr(nVal)
t = Timer
For r = 1 To UBound(arr)
arr(r) = "_" & Format$(r, "0000000")
Next r
Debug.Print Format$(Timer - t, "0.00"), "Fill 1D" ' 0.59
ReDim aArrs(nCyc)
t = Timer
For n = 1 To nCyc
aArrs(n) = arr
Next n
Debug.Print Format$(Timer - t, "0.00"), "Fill aArrs" ' 0.75
t = Timer
For n = 1 To nCyc
bV.ArrayDtoD aArrs(n)
Next n
Debug.Print Format$(Timer - t, "0.00"), "LBound 0" ' 0.00
t = Timer
For r = 1 To nVal
If arr(r) <> aArrs(1)(r - 1) Then Stop: End
Next r
Debug.Print Format$(Timer - t, "0.00"), "Check" ' 0.17
t = Timer
For n = 1 To nCyc
bV.ArrayDtoD aArrs(n), 1
Next n
Debug.Print Format$(Timer - t, "0.00"), "LBound 1" ' 0.00
t = Timer
For r = 1 To nVal
If arr(r) <> aArrs(1)(r) Then Stop: End
Next r
Debug.Print Format$(Timer - t, "0.00"), "Check" ' 0.15
t = Timer
For n = 1 To nCyc
bV.ArrayDtoD aArrs(n), 1, nVal / 2, 1, 2
Next n
Debug.Print Format$(Timer - t, "0.00"), "1D to 2D" ' 0.00
t = Timer: n = 0
For c = 1 To 2
For r = 1 To nVal / 2
n = n + 1: If arr(n) <> aArrs(1)(r, c) Then Stop: End
Next r
Next c
Debug.Print Format$(Timer - t, "0.00"), "Check" ' 0.19
t = Timer
For n = 1 To nCyc
bV.ArrayDtoD aArrs(n), 1
Next n
Debug.Print Format$(Timer - t, "0.00"), "2D to 1D" ' 0.00
t = Timer
For r = 1 To nVal
If arr(r) <> aArrs(1)(r) Then Stop: End
Next r
Debug.Print Format$(Timer - t, "0.00"), "Check" ' 0.17
End Sub
'==================================================================================================
Работает мгновенно для одномерного массива в 1млн элементов 10 раз в цикле. Порядок элементов соблюдается и проверен.
Я так понимаю, что назначение ArrayDtoD: • изменение нижних границ • "деления" одномерного на "столбцы" двумерного • "сцепки столбцов" двумерного в одномерный (друг под другом)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Не обязательно одномерного и двумерного. Размерность для сохраненных данных в массиве можно менять до 10. Главнаое правило, что бы размерности задавались так, что бы их общее произведение было равно первоначальному количеству элементов. Т.е. из одномерного массива в 100 элементов можно создать трехмерный 2*5*10. А из этого трехмерного, двумерный 25*4. А из этого двумерного одномерный 100. Он будет идентичен первому). Данные не удаляются и не обрезаются, а распределятся(остаются по факту как были) в том порядке, в котором были в изначальном масиве.
bedvit, понял, спасибо. Тут написал, что много однообразных тем и нужно что-то делать…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄