需要帮助改善我的VBA循环

Question

我有一个包含两列的Excel工作表，其中一列填充了字符串，另一列是emtpy。我想使用VBA根据另一列中相邻字符串的值分配空列中单元格的值。

我有以下代码：

Dim regexAdmin As Object 
Set regexAdmin = CreateObject("VBScript.RegExp") 
regexAdmin.IgnoreCase = True
regexAdmin.Pattern = "Admin" 

Dim i As Integer
For i = 1 To 10 'let's say there is 10 rows
    Dim j As Integer
    For j = 1 To 2
        If regexAdmin.test(Cells(i, j).Value) Then
            Cells(i, j + 1).Value = "Exploitation"
        End If
    Next j
Next i

问题在于，当使用这个循环来处理大量数据时，它需要花费太长时间才能工作，而且大多数情况下，它只会使Excel崩溃。

任何人都知道更好的方法吗？

Answer 1

您有一个不必要的循环，您也可以在其中测试刚刚完成的列（j）。掉落应该可以将速度提高10-50％

Dim regexAdmin As Object 
Set regexAdmin = CreateObject("VBScript.RegExp") 
regexAdmin.IgnoreCase = True
regexAdmin.Pattern = "Admin" 

Dim i As Integer
For i = 1 To 10 'let's say there is 10 rows
        If regexAdmin.test(Cells(i, 1).Value) Then
            Cells(i, 1).offset(0,1).Value = "Exploitation"
        End If
Next i

如果正则表达式模式真的只是＆＃34; Admin＆＃34;，那么您也可以使用工作表公式，而不是编写宏。您在文本列旁边放置的公式（假设您的字符串/ num col为A）将为：

=IF(NOT(ISERR(FIND("Admin",A1))),"Exploitation","")

一般来说，如果可以使用公式来完成，那么你最好这样做。它更容易维护。

Answer 2

试试这个：

Public Sub ProcessUsers()

    Dim regexAdmin As Object
    Set regexAdmin = CreateObject("VBScript.RegExp")
    regexAdmin.IgnoreCase = True
    regexAdmin.Pattern = "Admin"

    Dim r As Range, N As Integer, i As Integer
    Set r = Range("A1") '1st row is headers
    N = CountRows(r) - 1 'Count data rows

    Dim inputs() As Variant, outputs() As Variant
    inputs = r.Offset(1, 0).Resize(N, 1) ' Get all rows and 1 columns
    ReDim outputs(1 To N, 1 To 1)

    For i = 1 To N
        If regexAdmin.test(inputs(i, 1)) Then
            outputs(i, 1) = "Exploitation"
        End If
    Next i

    'Output values
    r.Offset(1, 1).Resize(N, 1).Value = outputs
End Sub


Public Function CountRows(ByRef r As Range) As Long
    If IsEmpty(r) Then
        CountRows = 0
    ElseIf IsEmpty(r.Offset(1, 0)) Then
        CountRows = 1
    Else
        CountRows = r.Worksheet.Range(r, r.End(xlDown)).Rows.Count
    End If
End Function