我有一个VBA宏,可以将数据写入已清除的工作表中,但它真的很慢!
我正在从 Project Professional 实例化 Excel。
Set xlApp = New Excel.Application
xlApp.ScreenUpdating = False
Dim NewBook As Excel.WorkBook
Dim ws As Excel.Worksheet
Set NewBook = xlApp.Workbooks.Add()
With NewBook
.Title = "SomeData"
Set ws = NewBook.Worksheets.Add()
ws.Name = "SomeData"
End With
xlApp.Calculation = xlCalculationManual 'I am setting this to manual here
RowNumber=2
Some random foreach cycle
ws.Cells(RowNumber, 1).Value = some value
ws.Cells(RowNumber, 2).Value = some value
ws.Cells(RowNumber, 3).Value = some value
...............
ws.Cells(RowNumber, 12).Value = some value
RowNumber=RowNumber+1
Next
我的问题是,foreach 循环有点大。最后,我将得到大约 29000 行。在一台相当不错的计算机上完成此操作需要超过 25 分钟。
有什么技巧可以加快写入单元格的速度吗? 我已完成以下操作:
xlApp.ScreenUpdating = False
xlApp.Calculation = xlCalculationManual
我是否以错误的方式引用单元格?是否可以写入整行而不是单个单元格?
这样会更快吗?
我已经测试了我的代码,foreach 循环运行得非常快(我将值写入了一些随机变量),所以我知道,写入单元格占用了所有时间。
如果您需要更多信息、代码片段,请告诉我。
感谢您的宝贵时间。
是否可以写成一整行,而不是单个单元格? 这样会更快吗?
是的,是的。这正是您可以提高性能的地方。众所周知,读取/写入单元格的速度很慢。您正在读取/写入多少个单元格并不重要,重要的是您为此对 COM 对象进行了多少次调用。因此,使用二维数组以块的形式读取和写入数据。
以下是将 MS Project 任务数据写入 Excel 的示例过程。我模拟了一个包含 29,000 个任务的时间表,它在几秒钟内运行。
Sub WriteTaskDataToExcel()
Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
xlApp.Visible = True
Dim NewBook As Excel.Workbook
Dim ws As Excel.Worksheet
Set NewBook = xlApp.Workbooks.Add()
With NewBook
.Title = "SomeData"
Set ws = NewBook.Worksheets.Add()
ws.Name = "SomeData"
End With
xlApp.ScreenUpdating = False
Dim OrigCalc As Excel.XlCalculation
OrigCalc = xlApp.Calculation
xlApp.Calculation = xlCalculationManual
Const BlockSize As Long = 1000
Dim Values() As Variant
ReDim Values(BlockSize, 12)
Dim idx As Long
idx = -1
Dim RowNumber As Long
RowNumber = 2
Dim tsk As Task
For Each tsk In ActiveProject.Tasks
idx = idx + 1
Values(idx, 0) = tsk.ID
Values(idx, 1) = tsk.Name
' populate the rest of the values
Values(idx, 11) = tsk.ResourceNames
If idx = BlockSize - 1 Then
With ws
.Range(.Cells(RowNumber, 1), .Cells(RowNumber + BlockSize - 1, 12)).Value = Values
End With
idx = -1
ReDim Values(BlockSize, 12)
RowNumber = RowNumber + BlockSize
End If
Next
' write last block
With ws
.Range(.Cells(RowNumber, 1), .Cells(RowNumber + BlockSize - 1, 12)).Value = Values
End With
xlApp.ScreenUpdating = True
xlApp.Calculation = OrigCalc
End Sub
这样做:
ws.Range(Cells(1, RowNumber), Cells(12, Number))=arr
其中 arr 是您的
some value
值的数组,例如
Dim arr(1 to 100) as Long
或者如果可能的话(甚至更快):
ws.Range(Cells(firstRow, RowNumber), Cells(lastRow, Number))=twoDimensionalArray
其中
twoDimensionalArray
是 some value
值的二维数组,例如
Dim twoDimensionalArray(1 to [your last row], 1 to 12) as Long
我当时的情况是,我正在填充巨大的表格,我必须逐个单元格,然后逐行进行。缓慢得令人痛苦。我仍然不确定为什么,但在循环之前我添加了:
cells(1,1).select
(如果重要的话,那就是我桌子外面的单元格 -idk)并且速度得到了显着的提高。我的意思是从 10 分钟到大约 30 秒。因此,如果您要写入表格中的单元格,请尝试一下。
我应该补充一点,我总是做的第一件事就是禁用事件、屏幕更新并切换到手动计算。在我尝试此解决方法之前,这没有帮助
之前的答案提到了做
cells(1,1).select
。
我的建议是在更新循环之前执行
Worksheets("Sheet2").Activate
。
将上面的
Sheet2
替换为任何未更新单元格的工作表。这带来了真正的实质性改进。即使您可以将应用程序显示更新设置为 false,更改激活的工作表确实可以消除开销。
我无法对特定帖子进行“评论”,因为我没有“50 声誉”...所以这是一般性回复。
我也一直在为此苦苦挣扎。我对一个“小型”数据库进行了查询,处理时间大约为 4 分钟。我在该过程之前添加了一个工作表(“不同的工作表”).activate 命令,现在它可以在 9 秒内运行。
奇怪!!!!但它奏效了。谢谢@pawel 和@adil B