缓慢的VBAmacros在单元格中写入
我有一个VBAmacros，它将数据写入已清除的工作表，但速度很慢！
我正在从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
我是以错误的方式引用单元格吗？ 有可能写一整行，而不是单个单元格？
这会更快吗？
我已经testing了我的代码，foreach循环很快就完成了（我把这些值写入了一些随机variables），所以我知道，写入单元格的时间总是占用很多时间。
如果你需要更多的信息，代码snipplets请让我知道。
感谢您的时间。
有可能写一整行，而不是单个单元格？ 这会更快吗？
是的，是的。 这正是您可以提高性能的地方。 读/写单元格的速度非常慢。 关于您正在读取/写入的单元的数量非常less，而是您要对COM对象进行多less次调用。 因此，使用二维数组读取和写入数据块。
以下是将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