Мое почтение, джентльмены! Новые инструменты для массива. Для массивов любого количества размерностей, типа - 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, приветствую ArrayCharLowerV, ArrayCharUpperV - как преобразуют числа? В текст или без изменений? Как преобразуют Empty? ArrayNumToCharV: Как преобразует Empty? ArrayCharToNumV: Как преобразует Empty? Как преобразует текст?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous написал: ArrayCharLowerV, ArrayCharUpperV - как преобразуют числа? В текст или без изменений? Как преобразуют Empty?
у чисел нет регистра. Никак, остаются как были.
Цитата
Jack Famous написал: ArrayNumToCharV: Как преобразует Empty?
не тестировал. Как придумали спецы Microsoft, использую их функцию.
Цитата
Jack Famous написал: ArrayCharToNumV: Как преобразует Empty? Как преобразует текст?
про Empty выше. Про строки: если строка похожа на число - в число, если нет, останется строка (алгоритм не мой, используется функция от Microsoft, ссылку выше разместил, можно погуглить тонкости или потестировать). Если будут тесты от тебя, я с интересом почитаю.
Преобразования регистров происходят заметно быстрее
Код
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
'==================================================================================================
'==================================================================================================
Любопытно, что при увеличении длины строки разница становится меньше.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
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
'==================================================================================================
Выводы:
• разделителем считает запятую, на точку не реагирует и не преобразовывает. Определяется Application.DecimalSeparator или International?… • на разделители даты не реагирует • отсутствие ноля не смущает. Преобразовывает • -0 (мнимый отрицательный ноль) оставляет, как есть (плохо) • числа с минусом на конце распознаёт и преобразовывает в обычные отрицательные. С 2мя минусами не преобразовывает. • числа в экспоненциальной записи (2e2, 2d2) распознаёт и преобразовывает • пробелы (обычные и неразрывные) игнорирует и преобразовывает в число • дату, записанную в VBA в виде #m/d/y# распознаёт и преобразовывает в целое число • переносы строк игнорирует и преобразовывает
Скорость впечатляет:4,23 сек для 20 млн преобразований различных строк вида: пробел & число (целое / десятичное / положительное / отрицательное) & неразрывный пробел
При сравнении преобразования "чистых" чисел, сохранённых, как текст (Cstr(num)) незначительно быстрее двойного отрицания.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Option Base 1 Option Explicit Option Private Module '================================================================================================== Private Sub Check() Dim a, b, n&
a = [a1:a8].Value b = a: BV.ArrayNumToCharV b
For n = 1 To UBound(a, 1) Debug.Print n, CStr(a(n, 1)) & "(" & TypeName(a(n, 1)) & ") | " & CStr(b(n, 1)) & "(" & TypeName(b(n, 1)) & ")" Next n End Sub '================================================================================================== Private Sub Compare() Dim a, aBV, aVBA Dim t!, u&, n&, c& Const nCyc& = 1000000
t = Timer ' Prepare a = [a1:a8].Value u = UBound(a, 1)
ReDim aBV(u * nCyc) ' 8mln ReDim aVBA(u * nCyc)
For n = 1 To UBound(aBV) If c = u Then c = 1 Else c = c + 1 aBV(n) = a(c, 1): aVBA(n) = aBV(n) Next n Debug.Print Format$(Timer - t, "0.00"), "Fill" ' 1.83
t = Timer ' Main For n = 1 To UBound(aVBA) aVBA(n) = CStr(aVBA(n)) Next n Debug.Print Format$(Timer - t, "0.00"), "VBA" ' 4.43
t = Timer ' Check For n = 1 To UBound(aVBA, 1) If IsError(aBV(n, 1)) Then aBV(n, 1) = CStr(aBV(n, 1)) If aVBA(n, 1) <> aBV(n, 1) Then Debug.Print n, aVBA(n, 1), aBV(n, 1): Stop: End Next n Debug.Print Format$(Timer - t, "0.00"), "Check" ' 0.00 End Sub '================================================================================================== '================================================================================================== '==================================================================================================
Работает около 2ух раз быстрее штатного CStr(), но НЕ ПРЕОБРАЗУЕТ ошибки в текст (хранит, как есть и можно выгрузить на лист)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
а по-моему, и так и так логично. Если преобразуешь ВСЁ в текст, то на выходе должен быть текст (как у CStr). С преобразованием в число, кстати, ошибки не тестил, но там было бы логичным оставлять, потому что ошибку нельзя в число преобразовать. Разве что NULL.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
В чем логичность для чисел ошибки оставлять, а для строк нет? Ошибка это не строка и не число, это другой тип данных (кстати больше на число похоже, т.к. там числовое значение содержится).
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄