我有一个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循环经历了相当快速(我将值写入一些随机变量),所以我知道,写入单元格是所有这些时间占用的。
如果您需要更多信息,可以告诉我们代码信息。
感谢您的时间。
答案 0 :(得分:7)
是否可以写一整行而不是单个单元格? 会更快吗?
是的,是的。这正是您可以提高性能的地方。对单元格的读/写非常慢。重要的是你正在读/写多少个单元,而是你要对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
答案 1 :(得分:3)
这样做:
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
答案 2 :(得分:0)
我当时处在要塞满巨大桌子的情况,必须逐格逐行,然后逐行。痛苦的缓慢。我仍然不确定为什么,但是在循环之前我添加了:
cells(1,1).select
(如果重要的话,这是我表外的单元格-idk),并且显着提高了速度。我的意思是从10分钟到大约30秒。因此,如果您要写入表中的单元格,那就去吧。
我应该补充一点,我一直要做的第一件事是禁用事件,屏幕更新并切换为手动计算。在尝试这种解决方法之前,这没有帮助
答案 3 :(得分:0)
上一个答案提到进行cells(1,1).select
。
我的建议是在更新循环之前执行Worksheets("Sheet2").Activate
。
将以上Sheet2
替换为不是更新单元格的任何工作表。这带来了真正的实质性改善。
即使您可以将应用程序displayupdupdating设置为false,更改已激活的工作表也可以真正消除开销。