VBA优化处理超过200,000个条目
我有超过20万行和9列，我正在看这个代码正在运行。 我基本上通过从IfElse语句input公式的前7行的代码循环。 如果条目＆（entry-1）是相同的，我还引用另一列。 这不需要很长时间，但问题是试图复制/粘贴其余的199,993个条目。 然后，我有另一个循环，只是将公式的前一行复制和粘贴到下一行等等。 这是永恒的。 所以，如果有什么东西可以使这个过程更快，我会很感激。 目前大约需要25分钟的时间。
Sub AddFormulas() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim endofcol As Long Dim endofrow As Long Dim i As Long Dim j As Long endofrow = 2 endofcol = 2 Do Until IsEmpty(Cells(endofcol, 7)) endofcol = endofcol + 1 Loop 'Find IP30Bopd Column With ActiveSheet.Range("A1:ZZ1") .Find("IP30Bopd").Select c = ActiveCell.Column r = ActiveCell.Row End With For j = 2 To 7 'ActiveSheet.Cells(j, c).Select ***Don't think it's needed For i = c To (c + 8) ActiveSheet.Cells(j, i).Select If i = c Then 'IP30Bopd Formula ActiveCell.FormulaR1C1 = "=RC[-2]/30.4" ElseIf i = c + 1 Then 'IP30Boed Formula ActiveCell.FormulaR1C1 = "=sum(RC[-3]:RC[-2])/6" ElseIf i = c + 2 Then 'IP30BoedX Formula ActiveCell.FormulaR1C1 = "=sum(RC[-4]:RC[-3])/14" ElseIf i = c + 3 Then 'IP90Bopd Formula ActiveCell.FormulaR1C1 = "=if(R[-2]C[-10]=RC[-10],average(R[-2]C[-3]:RC[-3]),""*"")" ElseIf i = c + 4 Then 'IP90Boed Formula ActiveCell.FormulaR1C1 = "=if(R[-2]C[-11]=RC[-11],average(R[-2]C[-3]:RC[-3]),"" * "")" ElseIf i = c + 5 Then 'IP90BoedX Formula ActiveCell.FormulaR1C1 ="=if(R[-2]C[-12]=RC[-12],average(R[-2]C[-3]:RC[-3]),"" * "")" ElseIf i = c + 6 Then 'IP180Bopd Formula ActiveCell.FormulaR1C1 ="=if(R[-5]C[-13]=RC[-13],average(R[-5]C[-6]:RC[-6]),"" * "")" ElseIf i = c + 7 Then 'IP180Boed Formula ActiveCell.FormulaR1C1 = "=if(R[-5]C[-14]=RC[-14],average(R[-5]C[-6]:RC[-6]),"" * "")" Else: i = c + 8 'IP180BoedX Formula ActiveCell.FormulaR1C1 = "=if(R[-5]C[-15]=RC[-15],average(R[-5]C[-6]:RC[-6]),"" * "")" End If Next i Next j For j = 7 To (endofcol - 1) ActiveSheet.Range(Cells(j, c), Cells(j, c + 8)).Copy Destination:=ActiveSheet.Cells(j + 1, c) Next j Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub 而不是逐行添加公式添加，然后一次。
工作表中仍然会有120万个公式。 使用VBA计算和更新值将会更有效率。
Option Explicit Sub AddFormulas() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim Start: Start = Timer Dim c As Range, Target As Range Dim lastRow As Long Dim FormulaR1C1 FormulaR1C1 = getR1C1Array Set Target = Range("A1:ZZ1").Find("IP30Bopd") If Not Target Is Nothing Then lastRow = Cells(Rows.Count, 1).End(xlUp).Row Set Target = Target.Offset(1).Resize(UBound(FormulaR1C1, 1), UBound(FormulaR1C1, 2)) Target.FormulaR1C1 = FormulaR1C1 Set Target = Target.Rows(Target.Rows.Count).Resize(lastRow - Target.Rows.Count) Target.Rows(1).AutoFill Destination:=Target 'Uncomment to replace worksheet formulas with their value for better performance Application.Calculation = xlCalculationAutomatic 'Try ConvertR1C1toValues with both True and False to see which is faster ConvertR1C1toValues Target, False End If Debug.Print "Execution Time: "; Timer - Start Application.ScreenUpdating = True End Sub Sub ConvertR1C1toValues(Target As Range, ColumnbyColumn As Boolean) Dim c As Range Set Target = Intersect(Target.EntireColumn, Target.Parent.UsedRange) If ColumnbyColumn Then For Each c In Target c.Value = c.Value Next Else Target.Value = Target.Value End If End Sub Function getR1C1Array() Dim data ReDim data(6) data(0) = Array("=RC[-2]/30.4", "=SUM(RC[-3]:RC[-2])/6", "=SUM(RC[-4]:RC[-3])/14", "=IF(R[1048574]C[-6]=RC[-6],AVERAGE(RC[9]:R[1048574]C[9]),""*"")", "=IF(R[1048574]C[-7]=RC[-7],AVERAGE(RC[9]:R[1048574]C[9]),"" * "")", "=IF(R[1048574]C[-8]=RC[-8],AVERAGE(RC[9]:R[1048574]C[9]),"" * "")", "=IF(R[1048571]C[-9]=RC[-9],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")", "=IF(R[1048571]C[-10]=RC[-10],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")", "=IF(R[1048571]C[-11]=RC[-11],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")") data(1) = Array("=RC[-2]/30.4", "=SUM(RC[-3]:RC[-2])/6", "=SUM(RC[-4]:RC[-3])/14", "=IF(R[-2]C[-6]=RC[-6],AVERAGE(R[-2]C[9]:RC[9]),""*"")", "=IF(R[-2]C[-7]=RC[-7],AVERAGE(R[-2]C[9]:RC[9]),"" * "")", "=IF(R[-2]C[-8]=RC[-8],AVERAGE(R[-2]C[9]:RC[9]),"" * "")", "=IF(R[1048571]C[-9]=RC[-9],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")", "=IF(R[1048571]C[-10]=RC[-10],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")", "=IF(R[1048571]C[-11]=RC[-11],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")") data(2) = Array("=RC[-2]/30.4", "=SUM(RC[-3]:RC[-2])/6", "=SUM(RC[-4]:RC[-3])/14", "=IF(R[-2]C[-6]=RC[-6],AVERAGE(R[-2]C[-3]:RC[-3]),""*"")", "=IF(R[-2]C[-7]=RC[-7],AVERAGE(R[-2]C[-3]:RC[-3]),"" * "")", "=IF(R[-2]C[-8]=RC[-8],AVERAGE(R[-2]C[-3]:RC[-3]),"" * "")", "=IF(R[1048571]C[-9]=RC[-9],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")", "=IF(R[1048571]C[-10]=RC[-10],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")", "=IF(R[1048571]C[-11]=RC[-11],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")") data(3) = Array("=RC[-2]/30.4", "=SUM(RC[-3]:RC[-2])/6", "=SUM(RC[-4]:RC[-3])/14", "=IF(R[-2]C[-6]=RC[-6],AVERAGE(R[-2]C[-3]:RC[-3]),""*"")", "=IF(R[-2]C[-7]=RC[-7],AVERAGE(R[-2]C[-3]:RC[-3]),"" * "")", "=IF(R[-2]C[-8]=RC[-8],AVERAGE(R[-2]C[-3]:RC[-3]),"" * "")", "=IF(R[1048571]C[-9]=RC[-9],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")", "=IF(R[1048571]C[-10]=RC[-10],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")", "=IF(R[1048571]C[-11]=RC[-11],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")") data(4) = Array("=RC[-2]/30.4", "=SUM(RC[-3]:RC[-2])/6", "=SUM(RC[-4]:RC[-3])/14", "=IF(R[-2]C[-6]=RC[-6],AVERAGE(R[-2]C[-3]:RC[-3]),""*"")", "=IF(R[-2]C[-7]=RC[-7],AVERAGE(R[-2]C[-3]:RC[-3]),"" * "")", "=IF(R[-2]C[-8]=RC[-8],AVERAGE(R[-2]C[-3]:RC[-3]),"" * "")", "=IF(R[-5]C[-9]=RC[-9],AVERAGE(R[-5]C[6]:RC[6]),"" * "")", "=IF(R[-5]C[-10]=RC[-10],AVERAGE(R[-5]C[6]:RC[6]),"" * "")", "=IF(R[-5]C[-11]=RC[-11],AVERAGE(R[-5]C[6]:RC[6]),"" * "")") data(5) = Array("=RC[-2]/30.4", "=SUM(RC[-3]:RC[-2])/6", "=SUM(RC[-4]:RC[-3])/14", "=IF(R[-2]C[-6]=RC[-6],AVERAGE(R[-2]C[-3]:RC[-3]),""*"")", "=IF(R[-2]C[-7]=RC[-7],AVERAGE(R[-2]C[-3]:RC[-3]),"" * "")", "=IF(R[-2]C[-8]=RC[-8],AVERAGE(R[-2]C[-3]:RC[-3]),"" * "")", "=IF(R[-5]C[-9]=RC[-9],AVERAGE(R[-5]C[-6]:RC[-6]),"" * "")", "=IF(R[-5]C[-10]=RC[-10],AVERAGE(R[-5]C[-6]:RC[-6]),"" * "")", "=IF(R[-5]C[-11]=RC[-11],AVERAGE(R[-5]C[-6]:RC[-6]),"" * "")") data(6) = Array("=RC[-2]/30.4", "=SUM(RC[-3]:RC[-2])/6", "=SUM(RC[-4]:RC[-3])/14", "=IF(R[-2]C[-6]=RC[-6],AVERAGE(R[-2]C[-3]:RC[-3]),""*"")", "=IF(R[-2]C[-7]=RC[-7],AVERAGE(R[-2]C[-3]:RC[-3]),"" * "")", "=IF(R[-2]C[-8]=RC[-8],AVERAGE(R[-2]C[-3]:RC[-3]),"" * "")", "=IF(R[-5]C[-9]=RC[-9],AVERAGE(R[-5]C[-6]:RC[-6]),"" * "")", "=IF(R[-5]C[-10]=RC[-10],AVERAGE(R[-5]C[-6]:RC[-6]),"" * "")", "=IF(R[-5]C[-11]=RC[-11],AVERAGE(R[-5]C[-6]:RC[-6]),"" * "")") data = Application.Transpose(data) data = Application.Transpose(data) getR1C1Array = data End Function Function getFormulaR1C1Array(Source As Range) Dim r As Range Dim Result As String Result = "Array(" For Each r In Source Result = Result & Chr(34) & Replace(r.FormulaR1C1, Chr(34), Chr(34) & Chr(34)) & Chr(34) & "," Next Result = Left(Result, Len(Result) - 1) & ")" getFormulaR1C1Array = Result End Function
更新：
我必须先行七行，才能让公式填写正确。
从工作表中提取公式数组 – select包含公式的所有单元格 – 在即时窗口中运行此行
对于x = 0到6：？“Data（”; x;“）=”; getFormulaR1C1Array（Selection.Offset（x））：Next
我build议处理数组中的所有条目，并且只有在完成所有计算后才能将数组分配给单元格Range
而不是使用ActiveSheet.Cells(j, i).Select使用Dim myArray(2 To 7, c To c + 8)
不要用公式进行计算，使用vba代码来计算数据，速度要快得多。
完成计算后，将数组分配给表单Range("A1:H7") = myArray
“A1：H7”只是一个样本，使用你需要的范围。