将数组的每个成员变为字母数字的最快方法是什么？

时间：2016-12-02 10:10:48

标签： arrays regex excel vba excel-vba

最后的最终结果：

我想知道如果字符串更长，下面的结果是否会改变。我在同一台计算机上运行完全相同的测试，除了每个单元格有一个34个字符而不是4个字符的随机字符串。结果如下：

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个四个字符串。

我家里的电脑是英特尔i7 @ 3.6 GHz，8GB内存，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

这样做的最快方法是什么？

对于上下文，我们的部件号可以有不同的形式，所以我正在编写一个函数，找到给定范围内的最佳匹配。目前，使所有字母数字运行的函数部分需要大约50ms才能运行，而函数的其余部分总共需要大约30ms。我也无法避免使用Excel。

我自己做了一些工作（见下面的答案），但主要的问题是我必须逐个遍历数组的每个元素 - 有没有更好的方法？我以前也从未进行过测试，所以任何关于改进它们的反馈都会非常感激。

这是我到目前为止所尝试的内容。

我正在使用MicroTimer，我的电脑配备了Intel i5 @ 2.5GHz，4GB内存，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毫秒

使用this post中的函数，我们将范围加载到数组中，将函数应用于数组的每个元素并将其粘贴回来。代码：

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。时间：171ms

定义一个正则表达式并使用它来替换数组的每个元素。

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

编辑：

@ThunderFrame - 我们的部件号通常采用以下格式：

  • 所有数字（例如32523452）
  • 字母和数字的混合（例如AB324K234或123H45645）
  • 字母和数字的混合，每个字母和数字由非字母数字字符链接（例如ABC001-001，ABC001 / 001,123 / 4557-121）

我已经考虑过在启动到替换之前在每个字符串上使用regex.test，但我不确定这是否只是复制字符串然后测试它，在这种情况下我也可以将替换为从...开始。

@Slai - 感谢链接 - 我将更详细地研究

5 个答案:

答案 0 :(得分：7)

不确定这是否会更快，因为它取决于太多因素，但可能值得测试。而不是Regex。分别放置每个值，您可以从剪贴板中获取复制的Range文本，并立即替换所有值。请注意，\w也匹配下划线和Unicode字母，因此在正则表达式中更具体，可以使其更快。 

'[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

由于剪贴板开销，我希望这对于较少的值来说会更慢，并且由于需要内存，可能会因为更多的值而变慢。

禁用事件似乎在我的测试中有所作为，但可能值得尝试。

请注意，当宏使用剪贴板时，其他应用程序使用剪贴板的可能性很小。

如果早期绑定导致在不同计算机上运行相同编译宏的问题，您可以搜索macro decompiler或删除引用并切换到后期绑定。

答案 1 :(得分：5)

归功于ThunderFrame（我是LHS Mid$的傻逼者），但我从早期的RegExp获得了更好的表现，并进行了额外的小调整：

  • 使用Value2而不是Value
  • 使用 long 而不是整数
    • 声明您的循环
  • .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

答案 2 :(得分：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版本

你的正则表达式方法具有合理的性能，但是你使用的是后期CreateObject，它作为一个早期绑定的强类型引用会更快。

此外，每次你的正则表达式模式和选项都是相同的，你可以将正则表达式对象声明为变量，只有在它不存在的情况下才创建它，然后每次重复使用现有的正则表达式。

答案 3 :(得分：2)

正则表达式必须成为赢家并不是事实。我下面的第二个解决方案甚至比早期绑定的Regex还要快！我的第一个解决方案是与后期Regex一样快。两者都是原生VBA。

有趣的问题。原始InStr方法应该比OP问题中显示的结果快得多。

它的性能差是由于字符串连接，而VBA则不擅长。字符串越长，效果越糟。

我下面的InStr方法版本根本不使用串联。它比原始速度快很多倍。实际上，它的执行速度与后期Regex匹配。这个InStr版本完全是VBA固有的，并且非常非常快。相对于串联，源字符串越长，获得的速度就越快。

通过使用字符串函数的（$）版本而不是变体版本，此方法还获得了一些性能提升。 InStrB比InStr快一点。并且使用临时字符串变量t和arx还可节省大量时间。

Sub InStr_ExcelHero()

    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 i&, j&, p&, max&, arx$, t$, res$, arr
        arr = inputRng
        max = Len(arr(1, 1))

    Dim validVals$: validVals = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"

        For i = LBound(arr) To UBound(arr)
            p = 0
            arx = arr(i, 1)
            res = Space$(max)
            For j = 1 To max
                t = Mid$(arx, j, 1)
                If InStrB(validVals, t) Then
                    p = p + 1
                    Mid$(res, p, 1) = t
                End If
            Next
            arr(i, 1) = Left$(res, p)
        Next

    outputRng = arr

    time2 = MicroTimer
    Debug.Print (time2 - time1) * 1000

End Sub

下面的ArrayLookup版本的速度是InStr_ExcelHero（）的两倍以上。

实际上，以下方法实际上比早期绑定的Regex快！

这是本机VBA。没有依赖关系。比Regex快。以下方法可能是将数组的每个元素转换为字母数字的最快方法...从VBA定向时...除了自定义c ++ dll之外，

Sub ArrayLookup_ExcelHero()

    Const VALS$ = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"

    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 i&, j&, p&, max&, t&, arx() As Byte, res() As Byte, arr
        arr = inputRng
        max = Len(arr(1, 1))

    Dim Keep&(0 To 255)
        For i = 1 To Len(VALS)
            Keep(Asc(Mid$(VALS, i, 1))) = 1
        Next

        For i = LBound(arr) To UBound(arr)
            p = 0
            ReDim res(0 To max)
            arx = StrConv(arr(i, 1), vbFromUnicode)
            For j = 0 To max - 1
                t = arx(j)
                If Keep(t) Then
                    res(p) = t
                    p = p + 1
                End If
            Next
            arr(i, 1) = StrConv(res, vbUnicode)
        Next

    outputRng = arr

    time2 = MicroTimer
    Debug.Print (time2 - time1) * 1000

End Sub

答案 4 :(得分：0)

我会把它扔出去，如果没别的话，看看它是如何表现的。我确定它也可以整理一下。

我希望测试角色是否是一个字母的方法更快。我确定可以更快地测试一个数字。

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
相关问题
最新问题