在单元格中缓慢写入VBA宏
我有一个VBA宏,它将数据写入一个清除的工作表中,但速度非常慢 我正在从项目专家那里实例化Excel在单元格中缓慢写入VBA宏,vba,excel,ms-project,Vba,Excel,Ms Project,我有一个VBA宏,它将数据写入一个清除的工作表中,但速度非常慢 我正在从项目专家那里实例化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" S
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循环非常快(我将值写入了一些随机变量),所以我知道,写入单元格占用了所有时间
如果您需要更多信息,请告诉我
谢谢您的时间。这样做:
ws.Range(Cells(1, RowNumber), Cells(12, Number))=arr
其中,arr是某些值的数组,例如
Dim arr(1 to 100) as Long
Dim twoDimensionalArray(1 to [your last row], 1 to 12) as Long
或者如果可能(甚至更快):
其中twodialarray
是某些值的二维数组,例如
Dim arr(1 to 100) as Long
Dim twoDimensionalArray(1 to [your last row], 1 to 12) as Long
有可能在一整行而不是单个单元格中写入吗?
那会更快吗
是的,是的。这正是您可以提高性能的地方。众所周知,读取/写入单元格的速度非常慢。读/写多少单元格并不重要,重要的是对COM对象进行多少调用。因此,使用二维数组在块中读取和写入数据
下面是将MS Project任务数据写入Excel的示例过程。我模拟了一个有29000个任务的时间表,这只需要几秒钟
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
我当时的处境是,我要填充一张巨大的表格,我必须一个单元格一个单元格地走,然后一行一行地走。慢得令人痛苦。我仍然不知道为什么,但在我的循环之前,我添加了:
cells(1,1).select
(如果这很重要的话,那就是我桌子外的单元格-idk),速度显著提高。我的意思是从10分钟到30秒。因此,如果您正在向表中的单元格写入数据,请尝试
我应该补充一点,我经常做的第一件事就是禁用事件、屏幕更新和切换到手动计算。在我尝试此解决方法之前,这并没有起到任何作用。前面的回答提到使用单元格(1,1)。选择
我的建议是做工作表(“Sheet2”)。在更新循环之前激活
- 将上面的
Sheet2
替换为未更新单元格的任何工作表。这导致了真正实质性的改善
- 即使您可以将application displayupdating设置为false,更改激活的工作表也可以真正消除开销
这样做ws.Range(单元格(1,行数),单元格(12,数))=arr
其中arr
是一个一些值的数组,例如Dim arr(1到100)的长度
。或者如果可能的话,ws.Range(单元格(第一行,行数),单元格(最后一行,行数))=twoDimensionalArray
可能值得考虑实现一个进度条。好吧,稍微缓和一下,但让用户放心,这一例行程序正在进行中。我不知道这是否适用于您,但对我来说,我设置了.Value=“”
。每一次呼叫都消耗了30-40毫秒(虽然很小,但要把它放在数百个项目的循环中!)。我把它改成了.ClearContents
,现在调用需要0毫秒。非常好的代码示例。唯一的问题是,这只会以1000的倍数写入行。因此,它将写入29000行,但不是29300行,因为它将生成300行,并且idx将不等于BlockSize-1,因此最后300行将被转储。@Laureant Oops,忘了这一部分!代码已经更新——只需要在For循环后重复3行With ws语句。这是否也适用于“断开连接”的单元格,例如A3、A7、A13等。。。?我有一个需要更新的字符串单元格列表(如“A3”、“A7”、“A13”、…)。@Onur否,您不能通过一次调用在不相连的范围上设置值,因为值
属性仅适用于范围对象的第一个区域。@RachelHettinger感谢您提供的信息。我想我必须坚持单值赋值,然后。。。