Инструменты для работы с массивами COM (VBA) - преобразование данных: регистра, строк, чисел

Пользователь

Сообщений: 2629 Регистрация: 02.04.2015

Виталий

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

«Бритва Оккама» или «Принцип Калашникова»?

Jack Famous

Пользователь

Сообщений: 12058 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

21.09.2022 09:31:36

bedvit, приветствую
ArrayCharLowerV, ArrayCharUpperV - как преобразуют числа? В текст или без изменений? Как преобразуют Empty?
ArrayNumToCharV: Как преобразует Empty?
ArrayCharToNumV: Как преобразует Empty? Как преобразует текст?

Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄

bedvit

Пользователь

Сообщений: 2629 Регистрация: 02.04.2015

Виталий

21.09.2022 09:41:48

Цитата
Jack Famous написал: ArrayCharLowerV, ArrayCharUpperV - как преобразуют числа? В текст или без изменений? Как преобразуют Empty?

у чисел нет регистра. Никак, остаются как были.

Цитата
Jack Famous написал: ArrayNumToCharV: Как преобразует Empty?

не тестировал. Как придумали спецы Microsoft, использую их функцию.

Цитата
Jack Famous написал: ArrayCharToNumV: Как преобразует Empty? Как преобразует текст?

про Empty выше. Про строки: если строка похожа на число - в число, если нет, останется строка (алгоритм не мой, используется функция от Microsoft, ссылку выше разместил, можно погуглить тонкости или потестировать).
Если будут тесты от тебя, я с интересом почитаю.

Изменено: bedvit - 21.09.2022 09:42:51

«Бритва Оккама» или «Принцип Калашникова»?

Jack Famous

Пользователь

Сообщений: 12058 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

22.12.2022 13:47:52

Преобразования регистров происходят заметно быстрее

Код

Option Base 1
Option Explicit
Option Private Module
'==================================================================================================
Sub Test_Case_LU_Simple()
Dim a, aLC(), aUC() ' aLC, aLC() или aLC() As String — не влияет на скорость цикла VBA LCase/UCase, но aLC() As String не получится обработать в BedVit даже после копирования в "a As Variant" (нужен цикл пересбора)
Dim tx$, t!, n&
Const nCyc& = 1000000

ReDim aLC(nCyc)
ReDim aUC(nCyc)

tx = "short"
'tx = "мое почтение, джентльмены! новые инструменты для массива. для массивов любого количества размерностей, типа - variant.version_com lbedvitcom.dll_v2.0.2.0. version_xll bedvitxll.dll_v3.2.2.0. преобразование происходит на месте (штатным инструментом variantchangetype). для всех элементов массива, для которых возможны преобразования: 1.arraycharlowerv - преобразовать все символы строки в нижний регистр 2.arraycharupperv - преобразовать все символы строки в верхний регистр 3.arraynumtocharv - преобразовать все данные в тип: strung 4.arraychartonumv - преобразовать все данные в тип: double"

t = Timer                                           ' short | long
    For n = 1 To nCyc
        aLC(n) = LCase$(tx)
        aUC(n) = UCase$(tx)
    Next n
Debug.Print Format$(Timer - t, "0.00"), "Fill"      ' 0,27  | 1.92

' LtoU ==========================================
t = Timer
    a = aLC
Debug.Print Format$(Timer - t, "0.00"), "Copy"      ' 0.09  | 0.63

t = Timer
    For n = 1 To nCyc
        a(n) = UCase$(a(n))
    Next n
Debug.Print Format$(Timer - t, "0.00"), "LtoU_VBA"  ' 0.22  | 1.41


t = Timer
    a = aLC
Debug.Print Format$(Timer - t, "0.00"), "Copy"      ' 0.17  | 1.33

t = Timer
    BV.ArrayCharUpperV a
Debug.Print Format$(Timer - t, "0.00"), "LtoU_BV"   ' 0.03  | 0.97

t = Timer
    For n = 1 To nCyc
        If a(n) <> aUC(n) Then Stop: End
    Next n
Debug.Print Format$(Timer - t, "0.00"), "Check"     ' 0,17  | 1.22


' UtoL ==========================================
t = Timer
    a = aUC
Debug.Print Format$(Timer - t, "0.00"), "Copy"      ' 0,16  | 1.42

t = Timer
    For n = 1 To nCyc
        a(n) = LCase$(a(n))
    Next n
Debug.Print Format$(Timer - t, "0.00"), "UtoL_VBA"  ' 0.22  | 1.17


t = Timer
    a = aUC
Debug.Print Format$(Timer - t, "0.00"), "Copy"      ' 0,16  | 1.25

t = Timer
    BV.ArrayCharLowerV a
Debug.Print Format$(Timer - t, "0.00"), "UtoL_BV"   ' 0.05  | 0.81

t = Timer
    For n = 1 To nCyc
        If a(n) <> aLC(n) Then Stop: End
    Next n
Debug.Print Format$(Timer - t, "0.00"), "Check"     ' 0,17  | 1.23
End Sub
'==================================================================================================
Sub Test_Case_LU_Mix()
Dim a, aLC(), aUC(), aOrig()
Dim tx$, t!, n&
Const nCyc& = 1000000

ReDim aOrig(nCyc)
ReDim aLC(nCyc)
ReDim aUC(nCyc)

tx = "sHoRt"
tx = "мое ПОЧТЕНИЕ, ДЖЕНТЛЬМЕНЫ! новые инструменты для массива. для массивов любого количества размерностей, типа - variant.version_com lbedvitcom.dll_v2.0.2.0. version_xll bedvitxll.Dll_v3.2.2.0. преобразоВание происходит на месте (штатным инструментом VARIANTCHANGETYPE). Для Всех Элементов Массива, Для Которых ВозмоЖны преобразования: 1.arraycharlowerv - преобразовать все СИМВОЛЫ строки в ниЖний регистр 2.arraycharupperv - ПРЕОБРАЗОВАТЬ Все Символы Строки В Верхний регистр 3.arraynumtocharv - ПРЕОБРАЗОВАТЬ все данные в тип: strung 4.arraycharTonuMv - преобразовать ВСЕ ДАННЫЕ в тип: double"

t = Timer                                           ' short | long
    For n = 1 To nCyc
        aOrig(n) = tx
        aLC(n) = LCase$(tx)
        aUC(n) = UCase$(tx)
    Next n
Debug.Print Format$(Timer - t, "0.00"), "Fill"      ' 0,30  | 3.23


' OtoU ==========================================
t = Timer
    a = aOrig
Debug.Print Format$(Timer - t, "0.00"), "Copy"      ' 0.13  | 0.94

t = Timer
    For n = 1 To nCyc
        a(n) = UCase$(a(n))
    Next n
Debug.Print Format$(Timer - t, "0.00"), "OtoU_VBA"  ' 0.20  | 1.53


t = Timer
    a = aOrig
Debug.Print Format$(Timer - t, "0.00"), "Copy"      ' 0.19  | 1.55

t = Timer
    BV.ArrayCharUpperV a
Debug.Print Format$(Timer - t, "0.00"), "OtoU_BV"   ' 0.03  | 1.45

t = Timer
    For n = 1 To nCyc
        If a(n) <> aUC(n) Then Stop: End
    Next n
Debug.Print Format$(Timer - t, "0.00"), "Check"     ' 0,13  | 0.92


' OtoL ==========================================
t = Timer
    a = aOrig
Debug.Print Format$(Timer - t, "0.00"), "Copy"      ' 0,17  | 1.36

t = Timer
    For n = 1 To nCyc
        a(n) = LCase$(a(n))
    Next n
Debug.Print Format$(Timer - t, "0.00"), "OtoL_VBA"  ' 0.22  | 1.47


t = Timer
    a = aOrig
Debug.Print Format$(Timer - t, "0.00"), "Copy"      ' 0,17  | 1.50

t = Timer
    BV.ArrayCharLowerV a
Debug.Print Format$(Timer - t, "0.00"), "OtoL_BV"   ' 0.05  | 1.33

t = Timer
    For n = 1 To nCyc
        If a(n) <> aLC(n) Then Stop: End
    Next n
Debug.Print Format$(Timer - t, "0.00"), "Check"     ' 0,13  | 0.88


' UtoU ==========================================
t = Timer
    a = aUC
Debug.Print Format$(Timer - t, "0.00"), "Copy"      ' 0.17  | 1.22

t = Timer
    For n = 1 To nCyc
        a(n) = UCase$(a(n))
    Next n
Debug.Print Format$(Timer - t, "0.00"), "UtoU_VBA"  ' 0.20  | 1.47


t = Timer
    a = aUC
Debug.Print Format$(Timer - t, "0.00"), "Copy"      ' 0.17  | 1.17

t = Timer
    BV.ArrayCharUpperV a
Debug.Print Format$(Timer - t, "0.00"), "UtoU_BV"   ' 0.05  | 1.25

t = Timer
    For n = 1 To nCyc
        If a(n) <> aUC(n) Then Stop: End
    Next n
Debug.Print Format$(Timer - t, "0.00"), "Check"     ' 0,11  | 0.69


' LtoL ==========================================
t = Timer
    a = aLC
Debug.Print Format$(Timer - t, "0.00"), "Copy"      ' 0,17  | 1.23

t = Timer
    For n = 1 To nCyc
        a(n) = LCase$(a(n))
    Next n
Debug.Print Format$(Timer - t, "0.00"), "LtoL_VBA"  ' 0.22  | 1.39


t = Timer
    a = aLC
Debug.Print Format$(Timer - t, "0.00"), "Copy"      ' 0,16  | 1.33

t = Timer
    BV.ArrayCharLowerV a
Debug.Print Format$(Timer - t, "0.00"), "LtoL_BV"   ' 0.05  | 1.33

t = Timer
    For n = 1 To nCyc
        If a(n) <> aLC(n) Then Stop: End
    Next n
Debug.Print Format$(Timer - t, "0.00"), "Check"     ' 0,13  | 0.91
End Sub
'==================================================================================================
'==================================================================================================

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

Цитата
bedvit: Strung

опечатка в п.3

Изменено: Jack Famous - 22.12.2022 14:14:02

Jack Famous

Пользователь

Сообщений: 12058 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

22.12.2022 14:32:52

ArrayCharToNumV. Как работает

Скрины

Код

Option Base 1
Option Explicit
Option Private Module
'==================================================================================================
Private Sub Check1()
Dim a, b, n&

a = Array(1, 1.1, -1, -1.1, 0, -0, 0.1, -0.1, #1/1/2022#, "1", "1,1", "1.1", "-1,1", "-1.1", "0", "-0", "0.1", "-0.1", "0,1", "-0,1", ".1", "-.1", ",1", "-,1", "  1,5", "1,5  ", "1  ,5", "1,  5", "  1  ,  5  ", "2e2", "2d2", "2-2", "2/2")
b = a: BV.ArrayCharToNumV b

For n = 1 To UBound(a)
    Debug.Print n, a(n) & "(" & TypeName(a(n)) & ")", b(n) & "(" & TypeName(b(n)) & ")"
Next n
End Sub
'==================================================================================================
Private Sub Check2()
Dim a, b, n&

a = Array("1", "1,1", "-1,1", "0", "-0", "-0,1", "0,1-", "-0,1-", ",1", "-,1")

For n = 1 To UBound(a)
    a(n) = ChrW(160) & vbCrLf & a(n) & vbCrLf & ChrW(160)
Next n

b = a: BV.ArrayCharToNumV b

For n = 1 To UBound(a)
    Debug.Print n, TypeName(a(n)), TypeName(b(n)), b(n)
Next n
End Sub
'==================================================================================================
Private Sub Speed()
Dim a, b()
Dim s#, t!, n&
Const lim& = 1000000, iStep# = 0.1

ReDim b(2 * lim * (1 / iStep) + 1)  '20 000 001

t = Timer: n = 0
    For s = -lim To lim Step iStep
        n = n + 1: b(n) = ChrW(32) & s & ChrW(160)
    Next s
Debug.Print Format$(Timer - t, "0.00"), "Fill"  ' 24.38

t = Timer
    a = b
Debug.Print Format$(Timer - t, "0.00"), "Copy"  ' 01.54

t = Timer
    BV.ArrayCharToNumV a
Debug.Print Format$(Timer - t, "0.00"), "Work"  ' 04.23

t = Timer: n = 0
    For s = -lim To lim Step iStep
        n = n + 1: If VarType(a(n)) <> vbDouble Or Abs(a(n) - s) > 0.0000001 Then Debug.Print n, s, a(n): Stop: End
    Next s
Debug.Print Format$(Timer - t, "0.00"), "Check" ' 02.81
End Sub
'==================================================================================================
Private Sub Compare()
Dim aBV, a(), aVBA()
Dim s#, t!, n&
Const lim& = 1000000, iStep# = 0.1

ReDim a(2 * lim * (1 / iStep) + 1)  '20 000 001

t = Timer: n = 0
    For s = -lim To lim Step iStep
        n = n + 1: a(n) = CStr(s)
    Next s
Debug.Print Format$(Timer - t, "0.00"), "Fill"  ' 19.66


t = Timer
    aVBA = a
    aBV = a
Debug.Print Format$(Timer - t, "0.00"), "Copy"  ' 03.73

t = Timer
    For n = 1 To UBound(a)
        aVBA(n) = --aVBA(n)
    Next n
Debug.Print Format$(Timer - t, "0.00"), "VBA"   ' 04.09

t = Timer
    BV.ArrayCharToNumV aBV
Debug.Print Format$(Timer - t, "0.00"), "BV"    ' 03.78


t = Timer
    For n = 1 To UBound(a)
        If Abs(aVBA(n) - aBV(n)) > 0.0000001 Then Debug.Print n, aVBA(n), aBV(n): Stop: End
    Next n
Debug.Print Format$(Timer - t, "0.00"), "Check" ' 01.29
End Sub
'==================================================================================================

Выводы:

Скорость впечатляет: 4,23 сек для 20 млн преобразований различных строк вида:
пробел & число (целое / десятичное / положительное / отрицательное) & неразрывный пробел

При сравнении преобразования "чистых" чисел, сохранённых, как текст (Cstr(num)) незначительно быстрее двойного отрицания.

Изменено: Jack Famous - 22.12.2022 15:31:40

Jack Famous

Пользователь

Сообщений: 12058 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

22.12.2022 16:09:45

ArrayNumToCharV

Работает около 2ух раз быстрее штатного CStr(), но НЕ ПРЕОБРАЗУЕТ ошибки в текст (хранит, как есть и можно выгрузить на лист)

Я бы так переименовал все процедуры:
1. ArrayCharLowerV — ArrayElements_ToLCase 2. ArrayCharUpperV — ArrayElements_ToUCase 3. ArrayNumToCharV — ArrayElements_ToString 4. ArrayCharToNumV — ArrayElements_ToDouble То, что вариант ждёт - так почти во всех твоих решениях и V тут лишняя (и в описании всё это указано).

Изменено: Jack Famous - 22.12.2022 16:53:46

bedvit

Пользователь

Сообщений: 2629 Регистрация: 02.04.2015

Виталий

22.12.2022 17:41:41

Цитата
Jack Famous написал: НЕ ПРЕОБРАЗУЕТ ошибки в текст

По-моему логично. Ведь я могу в тексте набрать "ошибка", это ошибка преобразования или текст. Как отобрать ошибки?

«Бритва Оккама» или «Принцип Калашникова»?

Jack Famous

Пользователь

Сообщений: 12058 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

22.12.2022 17:46:02

Цитата
bedvit: По-моему логично

а по-моему, и так и так логично. Если преобразуешь ВСЁ в текст, то на выходе должен быть текст (как у CStr). С преобразованием в число, кстати, ошибки не тестил, но там было бы логичным оставлять, потому что ошибку нельзя в число преобразовать. Разве что NULL.

Изменено: Jack Famous - 22.12.2022 17:46:33

bedvit

Пользователь

Сообщений: 2629 Регистрация: 02.04.2015

Виталий

22.12.2022 17:52:17

В чем логичность для чисел ошибки оставлять, а для строк нет? Ошибка это не строка и не число, это другой тип данных (кстати больше на число похоже, т.к. там числовое значение содержится).

«Бритва Оккама» или «Принцип Калашникова»?

Jack Famous

Пользователь

Сообщений: 12058 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

#10

22.12.2022 17:54:05

bedvit, соглашусь)

Все процедуры сохраняют ошибки нетронутыми

Изменено: Jack Famous - 22.12.2022 17:59:40

bedvit Пользователь Сообщений: 2629 Регистрация: 02.04.2015 Виталий	#11 22.12.2022 18:10:34 Да, выходит единый механизм отслеживания ошибок. «Бритва Оккама» или «Принцип Калашникова»?