Каков самый быстрый способ превратить каждый элемент массива буквенно-цифровой?
Конечные конечные результаты:
Мне было интересно, изменились ли результаты ниже, если строка была длиннее. Я выполнял точно такие же тесты на одном компьютере, за исключением того, что каждая ячейка имела случайную строку из 34 символов, а не четыре. Это были результаты:
Comintern (Regexp): 136.1 ms
brettdj (Regexp): 139.9 ms
Slai (Regexp): 158.4 ms
*Original Regex: 161.0 ms*
Comintern (AN): 170.1 ms
Comintern (Hash): 183.6 ms
ThunderFrame: 232.9 ms
*Original replace: 372.9 ms*
*Original InStr: 478.1 ms*
CallumDA33: 1218.1 ms
Это действительно показывает скорость Regex - все решения, использующие Regex.replace, значительно быстрее, причем лучше всего реализовать Comintern.
Итак, если строки длинны, используйте массивы, если они короткие, используйте буфер обмена. Если вы не уверены, оптимальным результатом будет использование массивов, но это может пожертвовать небольшой производительностью на коротких строках.
Конечные результаты:
Большое спасибо за все ваши предложения, ясно, что мне еще многое предстоит узнать. Я думал об этом вчера, поэтому решил перепробовать все дома. Вот окончательные результаты, основанные на применении каждого из них до 30 000 четырехзначных строк.
Мой компьютер дома - это Intel i7 @3.6 ГГц, 8 ГБ оперативной памяти, 64-разрядные версии Windows 10 и Excel 2016. Аналогичные условия для этого в том, что у меня есть процессы, работающие в фоновом режиме, но я не делаю ничего тесты.
Original replace: 97.67 ms
Original InStr: 106.54 ms
Original Regex: 113.46 ms
ThunderFrame: 82.21 ms
Comintern (AN): 96.98 ms
Comintern (OR): 81.87 ms
Comintern (Hash): 101.18 ms
brettdj: 81.66 ms
CallumDA33: 201.64 ms
Slai: 68.38 ms
Поэтому я принял ответ Slai, поскольку он, безусловно, является самым быстрым для общей реализации, но я перезапущу их всех на работу против фактических данных, чтобы проверить, что это все еще работает.
Оригинальное сообщение:
У меня есть массив в Excel, который является списком номеров деталей. Мне нужно, чтобы каждый элемент массива был буквенно-цифровым, например
ABC123-001 -> ABC123001
ABC123/001 -> ABC123001
ABC123001 -> ABC123001
Каков самый быстрый способ сделать это?
Для контекста наши номера деталей могут иметь разные формы, поэтому я пишу функцию, которая находит наилучшее соответствие в заданном диапазоне. На данный момент часть функции, которая делает все буквенно-цифровое, занимает около 50 мс, тогда как остальная часть функции занимает около 30 мс. Я также не могу избежать использования Excel.
Я сам проделал определенную работу (см. ответ ниже), но главная проблема заключается в том, что я должен прокручивать каждый элемент массива один за другим - может ли быть лучший способ? Я также никогда не запускал тесты раньше, поэтому любые отзывы об их улучшении будут очень оценены.
Вот что я пробовал до сих пор.
Я использую MicroTimer, а мой компьютер имеет Intel i5 @2.5GHz, 4 ГБ оперативной памяти, 64-битную Windows 7. я У меня есть процессы, работающие в фоновом режиме, но я не активно делаю что-либо еще, пока они запускаются.
Я создал 30 000 строк случайных символов, используя этот код:
=CHAR(RANDBETWEEN(1,60))&CHAR(RANDBETWEEN(48,57))&CHAR(RANDBETWEEN(37,140))&CHAR(RANDBETWEEN(37,140))
(обратите внимание, как мы останавливаем первый символ в 60, потому что '=' - char(61)
, и мы хотим, чтобы Excel не интерпретировал это как формулу. Также мы вынуждаем второго символа быть числом, чтобы мы могли гарантировать хотя бы один буквенно-цифровой символ.)
1. Использование цикла на основе случаев. Среднее время: 175 мс
Используя функцию в этом сообщении, мы загружаем диапазон в массив, применяем функцию к каждому элементу массива и вставляем его обратно. Код:
Function AlphaNumericOnly(strSource As Variant) As String
Dim i As Integer
Dim strResult As String
For i = 1 To Len(strSource)
Select Case Asc(Mid(strSource, i, 1))
Case 48 To 57, 65 To 90, 97 To 122: 'include 32 if you want to include space
strResult = strResult & Mid(strSource, i, 1)
End Select
Next
AlphaNumericOnly = strResult
End Function
Sub Replace()
Dim inputSh As Worksheet
Dim inputRng As Range
Set inputSh = Sheets("Data")
Set inputRng = inputSh.Range("A1:A30000")
Dim outputSh As Worksheet
Dim outputRng As Range
Set outputSh = Sheets("Replace")
Set outputRng = outputSh.Range("A1:A30000")
Dim time1 As Double, time2 As Double
time1 = MicroTimer
Dim arr As Variant
arr = inputRng
Dim i As Integer
For i = LBound(arr) To UBound(arr)
arr(i, 1) = AlphaNumericOnly(arr(i, 1))
Next i
outputRng = arr
time2 = MicroTimer
Debug.Print (time2 - time1) * 1000
End Sub
2. Использование InStr() для проверки каждого символа. Среднее время: 201 мс
Определите строку допустимых значений. Проверяйте один за другим, если в элементах массива отображаются допустимые значения:
Sub InStr()
Dim inputSh As Worksheet
Dim inputRng As Range
Set inputSh = Sheets("Data")
Set inputRng = inputSh.Range("A1:A30000")
Dim outputSh As Worksheet
Dim outputRng As Range
Set outputSh = Sheets("InStr")
Set outputRng = outputSh.Range("A1:A30000")
Dim time1 As Double, time2 As Double
time1 = MicroTimer
Dim arr As Variant
arr = inputRng
Dim validValues As String
validValues = "01234567890ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" 'put numbers and capitals at the start as they are more likely'
Dim i As Integer, j As Integer
Dim result As String
For i = LBound(arr) To UBound(arr)
result = vbNullString
For j = 1 To Len(arr(i, 1))
If InStr(validValues, Mid(arr(i, 1), j, 1)) <> 0 Then
result = result & Mid(arr(i, 1), j, 1)
End If
Next j
arr(i, 1) = result
Next i
outputRng = arr
time2 = MicroTimer
Debug.Print (time2 - time1) * 1000
End Sub
3. Использование regex.Replace в массиве. Время: 171 мс
Определите регулярное выражение и используйте его для замены каждого элемента массива.
Sub Regex()
Dim inputSh As Worksheet
Dim inputRng As Range
Set inputSh = Sheets("Data")
Set inputRng = inputSh.Range("A1:A30000")
Dim outputSh As Worksheet
Dim outputRng As Range
Set outputSh = Sheets("Regex")
Set outputRng = outputSh.Range("A1:A30000")
Dim time1 As Double, time2 As Double
time1 = MicroTimer
Dim arr As Variant
arr = inputRng
Dim objRegex As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Global = True
.ignorecase = True
.Pattern = "[^\w]"
End With
Dim i As Integer
For i = LBound(arr) To UBound(arr)
arr(i, 1) = objRegex.Replace(arr(i, 1), vbNullString)
Next i
outputRng = arr
time2 = MicroTimer
Debug.Print (time2 - time1) * 1000
End Sub
Edit:
@ThunderFrame - наши номера деталей обычно представлены в следующих форматах:
- Все номера (например, 32523452)
- Соединение букв и цифр (например, AB324K234 или 123H45645)
- Соединение букв и цифр, каждое из которых связано не-буквенно-цифровым символом (например, ABC001-001, ABC001/001, 123/4557-121).
Я думал об использовании regex.test для каждой строки перед запуском в замену, но я не уверен, что это просто скопирует строку, чтобы затем проверить ее, и в этом случае я могу просто сделать замену начните с.
@Slai - спасибо за ссылку - я рассмотрю это более подробно
Ответы
Ответ 1
Не уверен, что это будет быстрее, потому что это зависит от слишком многих факторов, но может стоить тестирования. Вместо Regex. Замените каждое значение отдельно, вы можете получить скопированный текст диапазона из буфера обмена и сразу заменить все значения. Обратите внимание, что \w
также соответствует символам подчеркивания и Юникода, поэтому более конкретное выражение в регулярном выражении может ускорить его выполнение.
'[a1:b30000] = [{"ABC123-009",""}]: Dim t As Double: t = Timer ' used for testing
Dim r As Range, s As String
Set r = ThisWorkbook.Worksheets("Data").UsedRange.Resize(, 1) ' Data!A1:A30000
With New MSForms.DataObject ' needs reference to "Microsoft Forms 2.0 Object Library" or use a bit slower late binding - With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
r.Copy
.GetFromClipboard
Application.CutCopyMode = False
s = .GetText
.Clear ' optional - clear the clipboard if using Range.PasteSpecial instead of Worksheet.PasteSpecial "Text"
With New RegExp ' needs reference to "Microsoft VBScript Regular Expressions 5.5" or use a bit slower late binding - With CreateObject("VBScript.RegExp")
.Global = True
'.IgnoreCase = False ' .IgnoreCase is False by default
.Pattern = "[^0-9A-Za-z\r\n]+" ' because "[^\w\r\n]+" also matches _ and Unicode letters
s = .Replace(s, vbNullString)
End With
.SetText s
.PutInClipboard
End With
' about 70% of the time is spent here in pasting the data
r(, 2).PasteSpecial 'xlPasteValues ' paste the text from clipboard in B1
'Debug.Print Timer - t
Я ожидаю, что это будет медленнее для меньших значений из-за накладных расходов буфера обмена и, возможно, медленнее для получения большего количества значений из-за необходимой памяти.
Отключение событий, похоже, не повлияло на мои тесты, но, возможно, стоит попробовать.
Обратите внимание, что есть небольшой шанс использования другого приложения, использующего буфер обмена, в то время как макрос использует его.
Если раннее связывание вызывает проблемы при запуске одного и того же скомпилированного макроса на разных машинах, вы можете выполнить поиск декомпилятор макроса или удалить ссылки и переключиться к позднему связыванию.
Ответ 2
tl; dr - Регулярные выражения уничтожают реализацию VBA. Если это вызов кода, @brettj или @Slai должны выиграть его.
Есть несколько трюков, чтобы сделать ваш AlphaNumericOnly
быстрее.
Во-первых, вы можете избавиться от подавляющего большинства вызовов функций, рассматривая его как байтовый массив вместо строки. Это удаляет все вызовы Mid$
и Asc
. Хотя это невероятно быстрые функции, они по-прежнему добавляют накладные расходы и выскакивают из стека вызовов. Это составляет более сотни тысяч итераций.
Вторая оптимизация - не использовать синтаксис Case x To y
, если вы можете его избежать. Причина связана с тем, как он компилируется - он не компилируется для теста типа Case = Condition >= x And Condition <= y
, он фактически создает цикл с условием раннего выхода следующим образом:
Case = False
For i = x To y
If Condition = i Then
Case = True
End If
Next
Опять же, не огромный удар по производительности, но он складывается. Третья оптимизация заключается в том, чтобы упорядочить ваши тесты таким образом, чтобы они сортировали схему по наиболее вероятным ударам в вашем наборе данных. Я приспособил свои примеры ниже для писем в основном, причем большинство из них - в верхнем регистре. Вы можете сделать лучше с другим порядком. Поместите все это вместе, и вы получите что-то похожее на это:
Public Function ByteAlphaNumeric(source As Variant) As String
Dim chars() As Byte
Dim outVal() As Byte
chars = CStr(source) 'Load the array up.
Dim bound As Long
bound = UBound(chars) 'Size the outbound array.
ReDim outVal(bound)
Dim i As Long, pos As Long
For i = 0 To bound Step 2 'Wide characters, only care about the ASCII range.
Dim temp As Byte
temp = chars(i) 'Pointer math isn't free. Cache it.
Select Case True 'Order is important here.
Case temp > 64 And temp < 91
outVal(pos) = temp
pos = pos + 2 'Advance the output pointer.
Case temp < 48
Case temp > 122
Case temp > 96
outVal(pos) = temp
pos = pos + 2
Case temp < 58
outVal(pos) = temp
pos = pos + 2
End Select
Next
'This is likely the most expensive operation.
ReDim Preserve outVal(pos) 'Trim the output array.
ByteAlphaNumeric = outVal
End Function
Как это сделать? Довольно хорошо:
Public Sub Benchmark()
Dim starting As Single, i As Long, dummy As String, sample As Variant
sample = GetRandomString
starting = Timer
For i = 1 To 1000000
dummy = AlphaNumericOnlyOP(sample)
Next i
Debug.Print "OP AlphaNumericOnly: ", Timer - starting
starting = Timer
For i = 1 To 1000000
dummy = AlphaNumericOnlyThunderframe(sample)
Next i
Debug.Print "ThunderFrame AlphaNumericOnly: ", Timer - starting
starting = Timer
For i = 1 To 1000000
dummy = AlphaNumeric(sample)
Next i
Debug.Print "CallumDA33 AlphaNumeric: ", Timer - starting
starting = Timer
For i = 1 To 1000000
dummy = ByteAlphaNumeric(sample)
Next i
Debug.Print "ByteAlphaNumeric: ", Timer - starting
Dim cast As String
cast = CStr(sample)
starting = Timer
For i = 1 To 1000000
dummy = ByteAlphaNumericString(cast)
Next i
Debug.Print "ByteAlphaNumericString: ", Timer - starting
Set stripper = Nothing
starting = Timer
For i = 1 To 1000000
dummy = OptimizedRegex(sample)
Next i
Debug.Print "OptimizedRegex: ", Timer - starting
End Sub
Private Function GetRandomString() As Variant
Dim chars(30) As Byte, i As Long
Randomize
For i = 0 To 30 Step 2
chars(i) = Int(96 * Rnd + 32)
Next i
Dim temp As String
temp = chars
GetRandomString = CVar(temp)
End Function
Результаты с 15 символами случайных String
:
OP`s AlphaNumericOnly: 6.565918
ThunderFrame`s AlphaNumericOnly: 3.617188
CallumDA33`s AlphaNumeric: 23.518070
ByteAlphaNumeric: 2.354980
Заметьте, я пропустил представления, которые не были тривиальными для преобразования в функции. Вы можете заметить 2 дополнительных теста: ByteAlphaNumericString
точно такой же, как и функция ByteAlphaNumeric
, но вместо Variant
он принимает String
и избавляется от приведения. Это не тривиально:
ByteAlphaNumericString: 2.226074
И, наконец, неуловимая функция OptimizedRegex
(в основном код @brettj в форме функции для сравнения):
Private stripper As RegExp 'Module level
Function OptimizedRegex(strSource As Variant) As String
If stripper Is Nothing Then
Set stripper = New RegExp
With stripper
.Global = True
.Pattern = "[^0-9A-Za-z]"
End With
End If
OptimizedRegex = stripper.Replace(strSource, vbNullString)
End Function
OptimizedRegex: 1.094727
EDIT: выполнение бонуса!
Мне пришло в голову, что поиск в хэш-таблице может быть быстрее структуры Select Case
, поэтому я построил один с помощью Scripting.Dictionary
:
Private hash As Scripting.Dictionary 'Module level
Function HashLookups(source As Variant) As String
Dim chars() As Byte
Dim outVal() As Byte
chars = CStr(source)
Dim bound As Long
bound = UBound(chars)
ReDim outVal(bound)
Dim i As Long, pos As Long
With hash
For i = 0 To bound Step 2
Dim temp As Byte
temp = chars(i)
If .Exists(temp) Then
outVal(pos) = temp
pos = pos + 2
End If
Next
End With
ReDim Preserve outVal(pos)
HashLookups = outVal
End Function
Private Sub LoadHashTable()
Set hash = New Scripting.Dictionary
Dim i As Long
For i = 48 To 57
hash.Add i, vbNull
Next
For i = 65 To 90
hash.Add i, vbNull
Next
For i = 97 To 122
hash.Add i, vbNull
Next
End Sub
'Test code:
starting = Timer
LoadHashTable
For i = 1 To 1000000
dummy = HashLookups(sample)
Next i
Debug.Print "HashLookups: ", Timer - starting
Это оказалось не слишком потрепанным:
HashLookups: 1.655273
Окончательная версия
Проснулся и подумал, что попробую векторный поиск вместо поиска хэша (просто заполните байтовый массив значений, чтобы сохранить и использовать это для тестов). Это кажется разумным в том, что это всего лишь 256-элементный массив - в основном таблица истинности:
Private lookup(255) As Boolean 'Module level
Function VectorLookup(source As Variant) As String
Dim chars() As Byte
Dim outVal() As Byte
chars = CStr(source)
Dim bound As Long
bound = UBound(chars)
ReDim outVal(bound)
Dim i As Long, pos As Long
For i = 0 To bound Step 2
Dim temp As Byte
temp = chars(i)
If lookup(temp) Then
outVal(pos) = temp
pos = pos + 2
End If
Next
ReDim Preserve outVal(pos)
VectorLookup = outVal
End Function
Private Sub GenerateTable()
Dim i As Long
For i = 48 To 57
lookup(i) = True
Next
For i = 65 To 90
lookup(i) = True
Next
For i = 97 To 122
lookup(i) = True
Next
End Sub
Предполагая, что таблица поиска генерируется только один раз, она работает примерно на 10-15% быстрее, чем любой другой чистый метод VBA выше.
Ответ 3
Кредит ThunderFrame (я присоска для LHS Mid$
), но я получил лучшую производительность с ранней привязки RegExp
с дополнительными небольшими настройками:
- Используйте
Value2
вместо Value
- Объявите свой цикл длинным целым числом
-
.ignorecase = True
является избыточным
код
Sub Replace2()
Dim inputSh As Worksheet
Dim inputRng As Range
Set inputSh = Sheets("Data")
Set inputRng = inputSh.Range("A1:A30000")
Dim outputSh As Worksheet
Dim outputRng As Range
Set outputSh = Sheets("Replace")
Set outputRng = outputSh.Range("A1:A30000")
Dim time1 As Double, time2 As Double
time1 = MicroTimer
Dim arr As Variant
Dim objRegex As VBScript_RegExp_55.RegExp
Dim i As Long
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Global = True
.Pattern = "[^\w]"
End With
arr = inputRng.Value2
For i = LBound(arr) To UBound(arr)
arr(i, 1) = objRegex.Replace(arr(i, 1), vbNullString)
Next i
outputRng.Value2 = arr
time2 = MicroTimer
Debug.Print (time2 - time1) * 1000
End Sub
Ответ 4
Если вы измените функцию в своей первой, и в настоящее время наиболее эффективной процедуре, на следующее, вы получите повышение производительности не менее 40-50% в зависимости от ваших данных:
Function AlphaNumericOnly(strSource As Variant) As String
Dim i As Long
Dim charCount As Long
Dim strResult As String
Dim char As String
strResult = Space$(Len(strSource))
For i = 1 To Len(strSource)
char = Mid$(strSource, i, 1)
Select Case Asc(char)
Case 48 To 57, 65 To 90, 97 To 122: 'include 32 if you want to include space
charCount = charCount + 1
Mid$(strResult, charCount, 1) = char
End Select
Next
AlphaNumericOnly = Left$(strResult, charCount)
End Function
Я использовал несколько оптимизаций, но главным образом, вы повторно назначали strResult
несколько раз в цикле, что очень дорого и даже дороже, когда ваши строки больше (и цикл работает больше). Гораздо лучше использовать Mid$
.
И, используя функции $-suffixed, оптимизированы для строк, поэтому вы также получите лучшую производительность
Оптимизация версии RegEx
Ваш подход Regex имеет разумную производительность, но вы используете позднюю привязку CreateObject
, которая будет намного быстрее, чем ранняя привязанная строго типизированная ссылка.
Кроме того, ваш шаблон и параметры Regex одинаковы каждый раз, вы можете объявить объект regex как переменную и только создать его, если он еще не существует, а затем повторно использовать существующее регулярное выражение каждый раз.
Ответ 5
Я выброшу это там, если больше ничего не увижу, как это работает. Я уверен, что его тоже можно было бы прибрать.
Моя надежда заключается в том, что метод проверки того, является ли символ буквой, быстрее. Я уверен, что тестирование на число можно сделать немного быстрее.
Function AlphaNumeric(s As String) As String
Dim char As String, tempStr As String
Dim i As Integer
Dim t As Variant
For i = 1 To Len(s)
char = Mid(s, i, 1)
If IsLetter(char) Or IsNumber(char) Then
tempStr = tempStr & char
End If
Next i
AlphaNumeric = tempStr
End Function
Private Function IsLetter(s As String) As Boolean
If UCase(s) = s And LCase(s) = s Then
IsLetter = False
Else:
IsLetter = True
End If
End Function
Private Function IsNumber(s As String)
On Error GoTo 1
s = s * 1
IsNumber = True
Exit Function
1:
IsNumber = False
End Function