Question

我有一张非常大的桌子。 700,000行。为了获得我需要的信息，我需要添加一个接收简单if或函数的列。问题是，它太慢了。它在60秒内只计算了7000行。我需要700,000 ...... 使用常规的Excel功能，它可以在几秒钟内完成。必须有办法用VBA做到这一点。谢谢！

这是我的代码：

Private Sub CommandButton3_Click()
    Sheet1.Cells(1, 6) = "C & O"

     'count rows
    Dim count As Long
    For i = 1 To 1000000
        If Sheet1.Cells(i, 1) <> "" Then
            count = count + 1
       Else: Exit For
        End If
    Next

    'Fill in coulmn F
    For K = 2 To count
        If (Sheet1.Cells(K, 4) = 651 Or Sheet1.Cells(K, 4) = 652 Or Sheet1.Cells(K, 4) = 653 Or Sheet1.Cells(K, 4) = 805 Or Sheet1.Cells(K, 4) = 806 Or Sheet1.Cells(K, 4) = 808 Or Sheet1.Cells(K, 4) = 804 Or Sheet1.Cells(K, 4) = 807 Or Sheet1.Cells(K, 4) = 809 Or Sheet1.Cells(K, 4) = 810) Then
            Sheet1.Cells(K, 6) = "Oversize"
        Else
            Sheet1.Cells(K, 6) = Sheet1.Cells(K, 5)
        End If
    Next
End Sub

Answer 1

简单优化可能只能读取一次Cell内容（它很慢）：

Dim k4
For K = 2 To count
    k4 = Sheet1.Cells(K, 4) 
    If (k4 = 651 Or k4 = 652 Or k4 = 653 Or k4 = 805 Or k4 = 806 Or k4 = 808 Or k4 = 804 Or k4 = 807 Or k4 = 809 Or k4 = 810) Then
        Sheet1.Cells(K, 6) = "Oversize"
    Else
        Sheet1.Cells(K, 6) = Sheet1.Cells(K, 5)
    End If
Next

如果这还不够，那么转换为数组可能是必要的。

Answer 2

我会按以下方式进行：

Application.ScreenUpdating = False

Dim cell As Range

For Each cell In Range(Range("A2"), Range("A2").End(xlDown))

    If (cell.Value >= 651 And cell.Value <= 653) Or _
        (cell.Value >= 804 And cell.Value <= 810) Then
        cell.Offset(0, 5).Value = "Oversize"
    Else
        cell.Offset(0, 5).Value = cell.Offset(0, 4).Value
    End If

Next cell

此行持续1秒，包含37000行数据。

Answer 3

在Surface 4平板电脑上，在0.96秒内有500K（50万）行。

Option Explicit

Public Sub CommandButton3_Click()
    Dim a As Long, arr As Variant
    Dim ca As Long

    appTGGL bTGGL:=False

    With Worksheets(Sheet1.Name)
        .Cells(1, 6) = "C & O"
        'you want count to be this,
        ca = .Cells(1, "A").End(xlDown).Row
        'it is more typically called like this,
        ca = .Cells(.Rows.count, "A").End(xlUp).Row

        'grab 2-D array of values from columns D:F
        arr = .Range(.Cells(1, "D"), .Cells(ca, "F")).Value2

        'loop through array
        For a = LBound(arr, 1) To UBound(arr, 1)
            Select Case arr(a, 1)
                Case 651, 652, 653, 804, 805, 806, 807, 808, 809, 810
                    arr(a, 2) = "oversize"
                Case Else
                    arr(a, 2) = arr(a, 3)
            End Select
        Next a

        'put the modified 2-D array back into the worksheet
        .Range(.Cells(1, "D"), .Cells(ca, "F")).Value2 = arr
    End With

    appTGGL

End Sub

Public Sub appTGGL(Optional bTGGL As Boolean = True)
    With Application
        .ScreenUpdating = bTGGL
        .EnableEvents = bTGGL
        .DisplayAlerts = bTGGL
        .AutoRecover.Enabled = bTGGL   'no interruptions with an auto-save
        .Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
        .CutCopyMode = False
        .StatusBar = vbNullString
    End With
    Debug.Print Timer
End Sub

我已经包含了一个“帮助”列，可暂时挂起各种应用程序环境设置，以加快程序。

在非常大的表中循环if函数。太慢

3 个答案: