arrays - 转换数组字母数字的每个成员的最快方法是什么？

Question

最终结果:

我想知道如果字符串更长，下面的结果是否会改变。我在同一台计算机上运行了完全相同的测试，只是每个单元格都有一个由 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 GHz、8GB RAM、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、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. 使用基于案例的循环。平均时间:175ms

使用 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() 检查每个字符。平均时间:201ms

定义一串有效值。一一检查有效值是否出现在数组元素中:

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 - 谢谢你的链接 - 我会更详细地研究这个

Answer 1

不确定这是否会更快，因为它取决于太多因素，但可能值得测试。您可以从剪贴板中获取复制的 Range 文本并一次性替换所有值，而不是 Regex.Replace 每个值。请注意 \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

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

禁用事件似乎对我的测试没有影响，但可能值得一试。

请注意，当宏正在使用剪贴板时，另一个应用程序使用剪贴板的可能性很小。

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