加快vba循环

Posted 2021-04-03

每周工作我都有大约15000个客户的文件，我需要根据他们的名字分成两个类别。我当前的代码可以工作，但它遍历每一行需要将近3分钟才能运行。什么是提高速度的最佳方法 - 我假设有比我使用的冗长if语句更有效的方法？

Option Compare Text

Private Sub CommandButton1_Click()

Dim i As Long

Application.ScreenUpdating = False

For i = 2 To Rows.Count

    If Cells(i, 33).Value = "Business" Then
        Cells(i, 32).Value = "B"
    ElseIf Cells(i, 33).Value = "Personal" Then
        Cells(i, 32).Value = "P"
    ElseIf Cells(i, 12).Value = "N" Then
        Cells(i, 32).Value = "B"
    ElseIf Cells(i, 12).Value = "Y" Then
        Cells(i, 32).Value = "P"
    ElseIf Cells(i, 20).Value = "PREMIER" Then
        Cells(i, 32).Value = "P"
    ElseIf InStr(1, Cells(i, 4), "LTD") <> 0 Then 'Finds each word in customer name, column D, and enters it as business customer
        Cells(i, 32).Value = "B"
    ElseIf InStr(1, Cells(i, 4), "LIMITED") <> 0 Then
        Cells(i, 32).Value = "B"
    ElseIf InStr(1, Cells(i, 4), "MANAGE") <> 0 Then
        Cells(i, 32).Value = "B"
    ElseIf InStr(1, Cells(i, 4), "BUSINESS") <> 0 Then
        Cells(i, 32).Value = "B"
    ElseIf InStr(1, Cells(i, 4), "CONSULT") <> 0 Then
        Cells(i, 32).Value = "B"
    ElseIf InStr(1, Cells(i, 4), "INTERNATIONAL") <> 0 Then
        Cells(i, 32).Value = "B"
    ElseIf InStr(1, Cells(i, 4), "T/A") <> 0 Then
        Cells(i, 32).Value = "B"
    ElseIf InStr(1, Cells(i, 4), "TECH") <> 0 Then
        Cells(i, 32).Value = "B"
    ElseIf InStr(1, Cells(i, 4), "CLUB") <> 0 Then
        Cells(i, 32).Value = "B"
    ElseIf InStr(1, Cells(i, 4), "OIL") <> 0 Then
        Cells(i, 32).Value = "B"
    ElseIf InStr(1, Cells(i, 4), "SERVICE") <> 0 Then
        Cells(i, 32).Value = "B"
    ElseIf InStr(1, Cells(i, 4), "SOLICITOR") <> 0 Then
        Cells(i, 32).Value = "B"
    ElseIf Cells(i, 4).Value = "UIT" Then
        Cells(i, 32).Value = "B"
    Else
        Cells(i, 32).Value = ""
    End If
Next i
Application.ScreenUpdating = True

End Sub

答案

如果你想加快这个过程，我会停止使用VBA，而是写一个公式。

示例：要查找单元格是否等于“Business”或“N”，您可以使用以下内容：

=IF(OR(A1="Business";A2="N");"B";"P")

要查找单元格是否包含“Business”，您可以使用以下内容：

=IF(FIND("Business";A1);"B";"P")

使用OR()工作表函数组合所有这些，您可以获得整个事物。显然，您需要将公式拖到工作表中的整个列上。

另一答案

尝试

Private Sub CommandButton1_Click()

    Dim i As Long, r As Long
    Dim vDB As Variant
    Dim Ws As Worksheet
    Dim rngDB As Range

    Set Ws = ActiveSheet
    Set rngDB = Ws.UsedRange
    vDB = rngDB
    r = UBound(vDB, 1)



    For i = 2 To r

        If vDB(i, 33) = "Business" Then
            vDB(i, 32) = "B"
        ElseIf vDB(i, 33) = "Personal" Then
            vDB(i, 32) = "P"
        ElseIf vDB(i, 12) = "N" Then
            vDB(i, 32) = "B"
        ElseIf vDB(i, 12) = "Y" Then
            vDB(i, 32) = "P"
        ElseIf vDB(i, 20) = "PREMIER" Then
            vDB(i, 32) = "P"
        ElseIf InStr(1, vDB(i, 4), "LTD") <> 0 Then 'Finds each word in customer name, column D, and enters it as business customer
            vDB(i, 32) = "B"
        ElseIf InStr(1, vDB(i, 4), "LIMITED") <> 0 Then
            vDB(i, 32) = "B"
        ElseIf InStr(1, vDB(i, 4), "MANAGE") <> 0 Then
            vDB(i, 32) = "B"
        ElseIf InStr(1, vDB(i, 4), "BUSINESS") <> 0 Then
            vDB(i, 32) = "B"
        ElseIf InStr(1, vDB(i, 4), "CONSULT") <> 0 Then
            vDB(i, 32) = "B"
        ElseIf InStr(1, vDB(i, 4), "INTERNATIONAL") <> 0 Then
            vDB(i, 32) = "B"
        ElseIf InStr(1, vDB(i, 4), "T/A") <> 0 Then
            vDB(i, 32) = "B"
        ElseIf InStr(1, vDB(i, 4), "TECH") <> 0 Then
            vDB(i, 32) = "B"
        ElseIf InStr(1, vDB(i, 4), "CLUB") <> 0 Then
            vDB(i, 32) = "B"
        ElseIf InStr(1, vDB(i, 4), "OIL") <> 0 Then
            vDB(i, 32) = "B"
        ElseIf InStr(1, vDB(i, 4), "SERVICE") <> 0 Then
            vDB(i, 32) = "B"
        ElseIf InStr(1, vDB(i, 4), "SOLICITOR") <> 0 Then
            vDB(i, 32) = "B"
        ElseIf vDB(i, 4) = "UIT" Then
            vDB(i, 32) = "B"
        Else
            vDB(i, 32) = ""
        End If
    Next i
    rngDB = vDB
End Sub