Доброго времени суток! Пытаюсь разобраться с решениями от bedvit'а…
UPD: теперь всё находится в одном месте и в одной надстройке. Библиотека подключается как обычная надстройка и регистрируется в реестре сама. Всё, что остаётся сделать — подключить ссылку на библиотеку для раннего связывания или просто использовать позднее (медленнее)
Пример программного раннего связывания (и «развязывания» ) из #6
Код
Sub RUN() 'ЗАПУСКАЕМ ДЛЯ РАННЕГО СВЯЗЫВАНИЯ
On Error Resume Next
ThisWorkbook.VBProject.References.AddFromGuid "{77D79CA3-15A0-4310-B8D8-0BCBE3F72D96}", 1, 0
On Error GoTo 0
'подключаем библу "BedvitCOM" в References - version(1.0) для раннего связывания (если библа уже подключена - On Error Resume Next)
'Для раннего связывания сначала включаем в References библу, потом в конце кода отключаем. Для позднего связывания этого не нужно (см.ниже).
'Если BedvitCOM не оключать, могут быть ошибки в этом файле при отсутствии зарегестрированной BedvitCOM - выслали кому-то файл, или открыли из другого ПК и т.д., где не установлеена или не открыта надстройка BedvitXLL (которая автоматом распаковывает и регистрирует библиотеку BedvitCOM в реестре) или не зарегистрированна BedvitCOM вручную
sort
ThisWorkbook.VBProject.References.Remove ThisWorkbook.VBProject.References("BedvitCOM") 'оключаем библу в References
End Sub
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Dim arr: ReDim arr(5 To testSize, 2 To 5) As String
Если открыть последнюю версию xll, выложенную здесь, то в ней уже запакована СОМ, и её не нужно регестрировать. Открывайте xll и сразу работайте с функциями листа и СОМ классами (все в одном). Кроме этого, там же в СОМ - есть TrimCOM (удаление пробелов) и два класса работы с длинной арифметикой (целые числи а числа с плавающей точкой/запятой). Описание здесь. Так же два эти же два класса представленны в функциях xll (C API - функциях)l: Категория BedvitXLLBignumArithmeticInteger: 1.ConvertBaseInteger - конвертирование целого числа (строки) из одной базы в другую (от 2 до 36). Квтегория BedvitXLLBignumArithmeticFloat: 1.SumFloat - сложение двух длинных/обычных чисел с плавающей точкой 2.SubtractFloat - вычитание двух длинных/обычных чисел с плавающей точкой 3.MultiplyFloat - умножение двух длинных/обычных чисел с плавающей точкой 4.DivideFloat - деление двух длинных/обычных чисел с плавающей точкой 5.PowerFloat - возведение в степень длинного/обычного числа 6.RootFloat - извлечение квадратного корня из длинного/обычного числа
Если использовать СОМ через раннее связывание, к каждой функции есть описания (функционал и параметры).
bedvit, открыл последнюю версию - там 2 файла для 64х - мне типа оба подключить?)) это же неудобно)) TrimCOM собираюсь активно юзать, функции для длинных чисел выдел ещё в старой COM - тоже можно заменить штатные, если уж влез
ArraySort: возлагал на неё большие надежды в плане сортировки всего подряд с последующим мгновенным бинарным поиском — представлял создания пользовательского словаря (увидел у Anchoret), основанного как раз на ваших наработках. А тут первое - стринговый массив (непонятно, как ему передавать данные с листа и вообще числа/даты), второе - он пока что так и не заработал/не сортирует…
FilterUnicodeChar: мощная и универсальная функция - мне нравится. Что не хватает: • передавать десятичные коды символы Юникода (чтобы также можно было задавать диапазон через ("минус" символ(45)) • дополнительный параметр Optional IfDel As Boolean. При активации, функция удаляет указанные символы, а не оставляет. Если дополнительные проверки замедляют, то сделать отдельную функцию. Почему: чтобы использовать вашу функцию в качестве замены штатной Clean нужно в цикле "For i=1 To 255" сформировать строку из (255-31-1 = 223) символов с присвоением каждому Chr(i). Это долго и неудобно. А если удалить нужно всего один-два, то совсем странно…
Другие функции: • очень хотелось бы заменить неповоротливую Split • часто приходиться искать ключ по словарю и подставлять значение. Думаю, что ваши варианты были бы гораздо шустрее
А вообще, конечно, я понимаю, что, если скорость не устраивает, то надо пересмотреть подход - или код поправить, или архитектуру баз, или вообще другие инструменты задействовать. У меня такой проблемы нет и использование ваших "плюшек" это не "мёртвому припарки", а, скорее, интересный эксперимент с блеском в глазах для восхищения небывалой скоростью. Последний раз такое было, когда я научился обрабатывать информацию в массивах, а не в ячейках
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
там один для х64, второй для х32(х86). Подключается один, нужной вам разрядности. По массиву - нормально работает и с цифрами/числами, просто VBA неявно преобразует число в String, если вы будите скармливать массиву числа. С датами не пробовал, думаю тоже должно быть все ОК (с форматами нужно тестировать). Т.е. Всё должно работать, или код в студию )
там 3 архива (см. скрин), в 2ух из которых есть х64 + вы там также пишите, что нужно все 3 разархивировать…
Код
Код
Option Explicit
'===========================================================================================
Const rMax& = 100000
'===========================================================================================
Sub sort()
Dim arrBefore, arrAfter() As String, str$, r&, t!
Dim bVBA As New BedvitCOM.VBA
t = Timer
Randomize
ReDim arrBefore(1 To rMax, 1 To 1) As String
For r = 1 To rMax
arrBefore(r, 1) = Rnd
Next r
arrAfter = arrBefore
Debug.Print Timer - t
t = Timer
bVBA.ArraySort (arrAfter)
Debug.Print Timer - t
t = Timer
shTest.Cells(1, 1).Resize(rMax, 1).Value2 = arrBefore
shTest.Cells(1, 2).Resize(rMax, 1).Value2 = arrAfter
Debug.Print Timer - t
'MsgBox "Время работы: " & Format$(Timer - t, "0.00 сек"), vbInformation, "ГОТОВО"
End Sub
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous написал: там 3 архива (см. скрин), в 2ух из которых есть х64 + вы там также пишите, что нужно все 3 разархивировать…
там 1 архив, разбит на три части. Для того чтобы разархивировать его нужно скачать все три части, и потом распаковать и выбрать нужный вам файл. В обратном случае вы можете не получить какую либо часть файла. ArraySort: - Все работает:
Код
Option Explicit
Const rMax& = 100000
Sub RUN() 'ЗАПУСКАЕМ ДЛЯ РАННЕГО СВЯЗЫВАНИЯ
On Error Resume Next
ThisWorkbook.VBProject.References.AddFromGuid "{77D79CA3-15A0-4310-B8D8-0BCBE3F72D96}", 1, 0
On Error GoTo 0
'подключаем библу "BedvitCOM" в References - version(1.0) для раннего связывания (если библа уже подключена - On Error Resume Next)
'Для раннего связывания сначала включаем в References библу, потом в конце кода отключаем. Для позднего связывания этого не нужно (см.ниже).
'Если BedvitCOM не оключать, могут быть ошибки в этом файле при отсутствии зарегестрированной BedvitCOM - выслали кому-то файл, или открыли из другого ПК и т.д., где не установлеена или не открыта надстройка BedvitXLL (которая автоматом распаковывает и регистрирует библиотеку BedvitCOM в реестре) или не зарегистрированна BedvitCOM вручную
sort
ThisWorkbook.VBProject.References.Remove ThisWorkbook.VBProject.References("BedvitCOM") 'оключаем библу в References
End Sub
Sub sort()
Dim arrBefore, arrAfter() As String, str$, r&, t!
Dim bVBA As New BedvitCOM.VBA
t = Timer
Randomize
ReDim arrBefore(1 To rMax, 1 To 1) As String
For r = 1 To rMax
arrBefore(r, 1) = Rnd * 1000
Next r
Debug.Print Timer - t
t = Timer
bVBA.ArraySort arrBefore
Debug.Print Timer - t
Cells(1, 1).Resize(rMax, 1).Value2 = arrBefore
Debug.Print Timer - t
End Sub
Цитата
Jack Famous написал: передавать десятичные коды символы Юникода (чтобы также можно было задавать диапазон через ("минус" символ(45))
Там и так можно задавать диапазон через минус. Знаки Юникода вы и так пишите в условии Строка в Excel - это Юникод строка.
Цитата
Jack Famous написал: функция удаляет указанные символы, а не оставляет
Да это полезно, добавлю.
Цитата
Jack Famous написал: Другие функции: • очень хотелось бы заменить неповоротливую Split • часто приходиться искать ключ по словарю и подставлять значение. Думаю, что ваши варианты были бы гораздо шустрее
Здесь надо проговаривать, что хотелось бы и будет ли эта функция полезна и массово использоваться. Ведь для написания нужно время, а времени мало, только на самое необходимое.
bedvit: чтобы разархивировать его нужно скачать все три части, и потом распаковать
я, конечно, заметил стрелку, но не придал значения. При перетаскивании файлы предлагалось заменить, а, если разархивировать все 3 в одно место (как вы и сказали), то всё гут - 2 надстройки и тесты. Теперь я знаю больше
Подготовил тестовый стенд и что-то результаты меня расстроили: скорость сравнима с рекурсией, а сортирует нормально (быстрее в 4 раза) только текст (числа и смешанные данные сортирует неверно)
Что я делаю не так? (в таблице время в мс)
Код
Option Explicit
Option Private Module
'===========================================================================================
'Const rMax& = 100000 ' задаём количество элементов одномерного массива
'Const iType As Byte = 2 ' задаём тип одномерного массива для создания: 0 - числа, 1 - текст, 2 - смешано
'Const TestRecursive As Boolean = 0 ' задаём тип сортировки (True - для рекурсии, False - для сортировки от bedvid'а)
'===========================================================================================
Dim arrBefore, arrAfter(), arrReport(4), txtReport$
Dim nElem&, rError&, nType As Byte
'===========================================================================================
Sub Start()
Dim t!
If [num].Value2 = "100k" Then nElem = 100000 Else nElem = 1000000
nType = WorksheetFunction.Match([Type].Value2, [Search], 0)
If [sort].Value2 = "bedvit" Then txtReport = "SortBedvit" Else txtReport = "SortRecursive"
Application.ScreenUpdating = False
' 1 ===============================
t = Timer
With shTest.Cells(1, 1).Resize(1000000, 2): .ClearContents: .Interior.Color = xlNone: End With
arrReport(0) = "SheetClear: " & Format$(1000 * (Timer - t), "0 ms")
' 2 ===============================
t = Timer
ArrayCreate
arrReport(1) = "ArrayCreate: " & Format$(1000 * (Timer - t), "0 ms") & vbLf & String$(20, "-")
' 3 ===============================
If txtReport = "SortBedvit" Then
t = Timer
SortBedvit
Else
t = Timer
arrAfter = arrBefore
SortRecursive arrAfter, 0, nElem - 1
End If
arrReport(2) = txtReport & ": " & Format$(1000 * (Timer - t), "0 ms") & vbLf & String$(20, "-")
' 4 ===============================
t = Timer
ArraysInsert
arrReport(3) = "ArraysInsert: " & Format$(1000 * (Timer - t), "0 ms")
' 5 ===============================
t = Timer
ArrayCheck
arrReport(4) = "ArraysInsert: " & Format$(1000 * (Timer - t), "0 ms")
' Msg =============================
Application.ScreenUpdating = True
txtReport = txtReport & vbLf & vbLf & Join(arrReport, vbLf) & vbLf & vbLf
If rError Then
MsgBox txtReport & "Ошибка на строке №" & rError, vbCritical, "ArrayCheck"
shTest.Cells(rError, 2).Interior.Color = vbRed: shTest.Cells(rError, 2).Select
Else
MsgBox txtReport & "Ошибок не выявлено", vbInformation, "ArrayCheck"
End If
'===========================================================================================
Erase arrBefore: Erase arrAfter: Erase arrReport
txtReport$ = ""
nElem = 0: nType = 0: rError = 0
End Sub
'===========================================================================================
Sub SortRecursive(arr1x(), l&, u&)
Dim i&, j&, x, y
i = l: j = u: x = arr1x((l + u) \ 2)
Do
Do While arr1x(i) < x: i = i + 1: Loop
Do While x < arr1x(j): j = j - 1: Loop
If i <= j Then y = arr1x(i): arr1x(i) = arr1x(j): arr1x(j) = y: i = i + 1: j = j - 1
Loop Until i > j
If l < j Then Call SortRecursive(arr1x, l, j)
If i < u Then Call SortRecursive(arr1x, i, u)
End Sub
'===========================================================================================
Sub SortBedvit()
Dim arrString, i&
Dim bVBA As Object
ReDim arrString(UBound(arrBefore)) As String
For i = 0 To UBound(arrBefore)
arrString(i) = arrBefore(i)
Next i
With CreateObject("BedvitCOM.VBA"): .ArraySort arrString: End With
ReDim arrAfter(UBound(arrString))
For i = 0 To UBound(arrString)
If IsNumeric(arrString(i)) Then arrAfter(i) = --arrString(i) Else arrAfter(i) = arrString(i)
Next i
End Sub
'===========================================================================================
'===========================================================================================
'===========================================================================================
Sub ArrayCheck()
Dim i&
For i = 0 To UBound(arrAfter) - 1
If arrAfter(i) > arrAfter(i + 1) Then rError = i + 1: Exit Sub
Next i
rError = 0
End Sub
'===========================================================================================
Sub ArrayCreate()
Dim i&
ReDim arrBefore(nElem - 1)
Randomize
If nType = 1 Then
For i = 0 To UBound(arrBefore)
arrBefore(i) = Rnd
Next i
ElseIf nType = 2 Then
For i = 0 To UBound(arrBefore)
arrBefore(i) = 1000000000 * Rnd
Next i
ElseIf nType = 3 Then
For i = 0 To UBound(arrBefore)
arrBefore(i) = --Format$(1000000000 * Rnd, "0")
Next i
ElseIf nType = 4 Then
For i = 0 To UBound(arrBefore)
arrBefore(i) = "_" & Format$(1000000000 * Rnd, "0000000000")
Next i
ElseIf nType = 5 Then
For i = 0 To UBound(arrBefore)
If i Mod 2 Then
arrBefore(i) = --Format$(1000000000 * Rnd, "0000000000")
Else
arrBefore(i) = "_" & Format$(1000000000 * Rnd, "0000000000")
End If
Next i
End If
End Sub
'===========================================================================================
Sub ArraysInsert()
Dim arr2x(), r&
ReDim arr2x(1 To nElem, 1 To 2)
For r = 1 To UBound(arr2x, 1)
arr2x(r, 1) = arrBefore(r - 1)
arr2x(r, 2) = arrAfter(r - 1)
Next r
shTest.Cells(1, 1).Resize(UBound(arr2x, 1), UBound(arr2x, 2)).Value2 = arr2x
End Sub
'===========================================================================================
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Function ArrayCreate(nType as Byte, nElem&) As Variant()
Dim arr(),i&
ReDim arr(nElem - 1)
Randomize
' Числа
If nType = 1 Then
For i = 0 To UBound(arr)
arr(i) = Rnd
Next i
' Числа
ElseIf nType = 2 Then
For i = 0 To UBound(arr)
arr(i) = 1000000000 * Rnd
Next i
' Числа
ElseIf nType = 3 Then
For i = 0 To UBound(arr)
arr(i) = --Format$(1000000000 * Rnd, "0")
Next i
' Текст
ElseIf nType = 4 Then
For i = 0 To UBound(arr)
arr(i) = "_" & Format$(1000000000 * Rnd, "0000000000")
Next i
' Числа + Текст
ElseIf nType = 5 Then
For i = 0 To UBound(arr)
If i Mod 2 Then
arr(i) = --Format$(1000000000 * Rnd, "0000000000")
Else
arr(i) = "_" & Format$(1000000000 * Rnd, "0000000000")
End If
Next i
End If
ArrayCreate=arr
End Function
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Sub ArrayCreate()
Dim arr, i&
Dim bVBA As New BedvitCOM.VBA
ReDim arr(1000000) As String
Randomize
' Числа дробные
For i = 0 To UBound(arr)
arr(i) = 1000000000 * Rnd
Next i
t = Timer
bVBA.ArraySort arr
Debug.Print "Числа дробные", Timer - t
' Числа целые одноформатные
For i = 0 To UBound(arr)
arr(i) = Format$(1000000000 * Rnd, "0000000000")
Next i
t = Timer
bVBA.ArraySort arr
Debug.Print "Числа целые одноформатные", Timer - t
' Текст
For i = 0 To UBound(arr)
arr(i) = "_" & Format$(1000000000 * Rnd, "0000000000")
Next i
t = Timer
bVBA.ArraySort arr
Debug.Print "Текст", Timer - t
' Числа + Текст
For i = 0 To UBound(arr)
arr(i) = "_" & Format$(1000000000 * Rnd, "0000000000")
Next i
t = Timer
bVBA.ArraySort arr
Debug.Print "Числа + Текст", Timer - t
End Sub
Тайминг, секунд на 1 000 000 строк. Числа дробные - 0,109375 Числа целые одноформатные - 0,1054688 Текст - 0,140625 Числа + Текст - 0,140625
Особенности: т.к. изначально эта библиотека писалась для строк, сортировка происходит по алгоритму строк. по первым, вторым, третьим и т.д. символам. т.е. дробные числа и числа разной размерности могут сортироваться не так как хотелось бы для числа. Пример: 122,25 12225 2,25 225 Решение: использовать библиотеку для строк (или сортировать одноформатные целые числа - добавляя нули сначала) или когда будет время, реализую сортировку и по числовым значениям.
bedvit, ну если только для текста, то некорректно сравнивать с "всеядной" рекурсией. Скорость сортировки текста действительно впечатляет, но всё-таки не в 35 раз, а в 4, при условии "реальности" происходящего. Я имею ввиду, что неплохо бы алгоритму иметь возможность работать с вариативным массивом arr() или вообще с вариативной переменной arr, т.к. в реальности строковый массив создаётся только кодом, а с листа всё забирается в вариативную переменную или в вариативный массив. Именно поэтому, я её "замедлил" циклами перевода.
Вот тут, кстати, Anchoret делал тестовый сортер по байтам и предварительной фильтрацией по первым 3ём символам… Быстрее рекурсии на десятках тысяч, но потом зарывается…
FilterUnicodeChar:
Цитата
bedvit: Там и так можно задавать диапазон через минус. Знаки Юникода вы и так пишите в условии Строка в Excel - это Юникод строка
про диапазон знаю, но вы же понимаете, что некоторые символы просто не ввести (например AscW), в то же время их полно во всяких выгрузках. Например, ваша функция мне нужна для очистки текста как раз после таких выгрузок - что же мне теперь циклы делать ил же просто передать десятичный код из таблицы Юникода?…
Цитата
bedvit: будет ли эта функция полезна и массово использоваться
думаю, что Split - точно да (уж слишком тормозная), а вот аналог словаря с суперпоиском на отсортированном списке не все поймут, т.к. он будет выгоден только на больших объёмах, но я очень ЗА
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous написал: то некорректно сравнивать с "всеядной" рекурсией.
а я не сравниваю. Я так и написал в теме, в которой выкладывал эту библу: Сортируйте в VBA и удаляйте дубликаты на скоростях С++ до 35 раз быстрее самого быстрого алгоритма (QuickSort) по типу данных: "String" Если есть сортировка строк быстрее чем QuickSort, давайте сравним с вашей, протестируем на 2 млн. строк. Я не против, если будет меньше чем в 35 раз, скорректирую описание. Откуда взялось в 4 раза, я не знаю, давайте массив, сравним.
bedvit: Откуда взялось в 4 раза, я не знаю, давайте массив, сравним
в 4 раза - по моим тестам, где я дополнительно перевожу в String и обратно в Variant. Ничего корректировать не надо —я не к этому написал. Моя невнимательность, прошу прощения - про String не увидел…
это дополнительные 9 символов для каждого кода или формирование строки в цикле, что и неудобно и время жрёт. А разве внутри функции не происходит преобразование в Юникод? Разве не будет быстрее ей передавать коды напрямую? На крайняк, эту версию можно оставить для "кухонного" применения, а другую сделать для использования в коде VBA на символах юникода…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
я работаю в Excel. У меня есть таблица, которую я хочу забрать в память, чтобы потом отсортировать и в любой момент мгновенно получать по ключу значения любого поля (бинарный поиск по отсортированному массиву). Самый быстрый способ забрать массив с листа — arr = rng.Value2, где arr является вариативной переменной, а rng - диапазоном. Полученный массив передать в вашу библиотеку нельзя - нужно сперва преобразовать её в цикле. Выгрузить обратно тоже нельзя - нужно сначала в цикле преобразовать в вариативный массив, попутно исправляя числа-как-текст. Выходит, в "полевых" условиях часть мощности просто теряется при преобразованиях…
мне этого достаточно жду версию "удалить указанные символы". Кстати, в текущей версии "оставить указанные" сколько символов удаляется? Весь Юникод? Десятки тысяч?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
если сортировать по числам или, например тексту, который представляет собой число с "добитыми" нулями до нужной длины (типа Format$(2.12,"000000")), то всё ОК, но текстовые строки он сортирует не совсем так, чтобы они соответствовали проверке больше/меньше (даже при сортировке с учётом регистра)
Цитата
bedvit: будет удаляться все символы, не входящие в выбранные (весь Юникод)
всё понял - спасибо! Буду ждать
Проверка массива после сортировки
Код
Sub ArrayCheck()
Dim i&
For i = 0 To UBound(arrAfter) - 1
If arrAfter(i) > arrAfter(i + 1) Then rError = i + 1: Exit Sub
Next i
rError = 0
End Sub
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Эти скобки еще и тормозят чрезмерно, так как для VBA они означают, что нужно создать временную переменную As Variant и в нее скопировать весь массив. Посмотрите, чего стоят лишние скобки на таком примере:
Код
Sub Test()
Const rMax = 1000000
Dim r As Long, t As Single, s As String, arr()
s = String(2000, "x")
ReDim arr(1 To rMax, 1 To 1)
t = Timer
For r = 1 To UBound(arr)
arr(r, 1) = s
Next
Debug.Print 1, Round(Timer - t, 3)
t = Timer
Dummy arr '<-- Суперскорость
Debug.Print 2, Round(Timer - t, 3)
t = Timer
Dummy (arr) '<-- Супертормоз
Debug.Print 3, Round(Timer - t, 3)
End Sub
Function Dummy(x)
' Do nothing
End Function
bedvit, ответил - спасибо Alec Perle, если и так, то тогда не ошибка, а не совсем правильно - ведь работает Спасибо за замечание) ZVI, фигасе Апну тему в понедельник, после тестов. Большое вам спасибо за объяснение, Владимир!
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Результаты по тестам от ZVI предельно однозначны: • при изменении количества элементов массива, длины тестовой строки, типа и размерности массива — время работы изменяется линейно с разницей в 2-5 раз • если параметр функции/процедуры не передавать по ссылке (Dummy(ByVal arr)), то выигрыш теряется и время выполнение сопоставимо, что как раз и доказывает,
Цитата
ZVI: что нужно создать временную переменную As Variant и в нее скопировать весь массив
Для порядка скажу, что, если вынести цикл из функции в основной код - это будет ещё быстрее и правильнее
Код
Option Explicit'===========================================================================================
Sub Test()
Dim arr, s$, i&, t1!, t2!
Const rMax& = 1000000
t1 = Timer
s = String(1000, "x")
ReDim arr(rMax - 1)
For i = LBound(arr) To UBound(arr)
arr(i) = s
Next i
Debug.Print Format$(Timer - t1, "0.000")
' SlowMo
t1 = Timer
For i = LBound(arr) To UBound(arr)
Dummy (arr(i))
Next i
t1 = Timer - t1
' Fast
t2 = Timer
Fast arr
t2 = Timer - t2
Debug.Print Format$(1000 * (t1 - t2), "0 ms") & " : " & Format$(t1 / t2, "0.00 freq")
End Sub
'===========================================================================================
Sub Fast(arr)
Dim i&
For i = LBound(arr) To UBound(arr)
arr(i) = "_" & arr(i)
Next i
End Sub
'===========================================================================================
Sub Dummy(txt$)
txt = "_" & txt
End Sub
'===========================================================================================
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
bedvit, продолжаем размышлять: 1. Что насчёт массива, в котором могут быть и строковые и числовые значения? 2. Что насчёт замены штатной Replace 3. Что насчёт замены штатной Split?
Раздумия: 1. Сортировка массива - вещь крутая и нужная, но рекурсивный вариант неплохо справляется 3.Split хоть и долгая до безобразия, но компенсируется тем, что я её почти не использую. К тому же уже есть неплохая замена судя по тестам (я не тестил)
После раздумий, если выбирать что-то одно, то я бы выбрал Replace. Хотя вроде также есть что-то пошустрее, думаю, что у вас на C++/C# получится кратное превосходство.
Replace ОЧЕНЬ часто используется и является довольно универсальной: • удалить один или несколько символов (не нужно - есть FilterUnicodeChar) • удалить сочетание символов • заменить двойные символы на одинарные
Что я заметил: хоть Replace и не удаляет ничего, если в строке нет нужного, но добавление условия If Instr(1, строка, что_ищем) позволяет стабильно ускорить процесс. Если возьмётесь, то было бы круто вшить что-то подобное внутрь.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
bedvit: главное что бы нужные функции реализовывать
приветствую! Так я только про самые нужные)) Нужнее только InStr, но обогнать её будет не так-то просто (наверное)
Почитал вчера внимательно про штатную Replace, а в частности про 3 необязательных аргумента к ней: 1. старт: удобная штука, которая может ускорить процесс, если ты знаешь, с какого символа искать. Минус: штатная обрезает всё, что было ДО стартовой позиции - типа как гибрид Replace$(str,find,replace,start) = Replace$(Mid$(str,start),find,replace). 4ый параметр - оно, конечно, побыстрее будет гибрида, но вот обрезать-то одновременно с поиском редко приходится))) куда логичнее было этот 4ый параметр использовать, как в InStr, а именно - искать НЕ с начала, тем самым ускорив пока что-то мимо… 2. количество замен: пользовал несколько раз, но очень редко 3. учитывать регистр: крайне редко.
Итого: 1. Может быть 2. Вряд ли 3. Вряд ли
Если думать, что каждая опция в цикле может замедлить выполнение процедуры, то я бы отказался от всех, оставив 3 основных аргумента.
Отдельно нужно продумать (я ХЗ как) алгоритм замены двойных символов на одинарные: • по моим тестам (не все варианты) Replace стабильно заменит все "дубли" на одинарные за 3 прохода, однако, можно ускорить, добавив проверку:
Код
Do While InStr(1, iVal, txt)
iVal = Replace$(iVal, txt, x)
Loop
• регулярки как-то делают это за 1 проход (пример с TrimRE), причём очень шустро. Не знаю, насколько последняя инфа нужна, ведь это принципиально другой инструмент
ПРОБЛЕМА Библиотека очень часто крашится… В основном, когда подключена одновременно и к надстройке (сторонней) и к активной книге
Сигнатура проблемы:
Код
Имя события проблемы: APPCRASH
Имя приложения: EXCEL.EXE
Версия приложения: 16.0.10325.20082
Отметка времени приложения: 5b525820
Имя модуля с ошибкой: ntdll.dll
Версия модуля с ошибкой: 6.1.7601.18247
Отметка времени модуля с ошибкой: 521eaf24
Код исключения: c0000005
Смещение исключения: 00000000000532f2
Версия ОС: 6.1.7601.2.1.0.768.2
Код языка: 1049
Дополнительные сведения об этой проблеме:
LCID: 1049
skulcid: 1049
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Хорошо. Напишите тестовый стенд для InStr и Replace. Только проще, не тот который по ссылке 30 строк результатов. Чем проще, тем лучше. Один результат на функцию. Еще, сравнение и расчет будет по знакам Юникода (регистрозависимый). Слова "тест" и "ТЕСТ" будут считаться разными в поиске и замене (не будет параметра "compare"). Подходит?