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

我有一个非常大的桌子。 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万3千7万行的数据。

Answer 3

在Surface 4平板电脑上以0.96秒的时间排列500K（五十万）行。

 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 

我已经join了一个“帮手”的列，暂时中止各种应用程序的环境设置，以加快程序。