Slow VBA macro writing in cells

Question

У меня есть макрос VBA, который записывает данные в очищенный рабочий лист, но он очень медленный!

Я создаю Excel из Project Professional.

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 проходит довольно быстро (я написал значения в некоторые случайные величины), поэтому я знаю, что запись в ячейки - это то, что занимает все это время.

Если вам нужна дополнительная информация, сниппеты кода, пожалуйста, дайте мне знать.

Спасибо за ваше время.

Answer 1

было бы возможно, чтобы написать в целой строки, а не из отдельных клеток? Будет ли это быстрее?

Да и да. Это именно то, где вы можете повысить производительность. Чтение/запись в ячейки, как известно, медленно. Очень важно, сколько ячеек вы читаете/пишете, а сколько звонков, которые вы делаете для 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 

Answer 2

Делают это так:

ws.Range(Cells(1, RowNumber), Cells(12, Number))=arr 

Где обр массив ваших some value значений, например,

Dim arr(1 to 100) as Long 

Или, если это возможно (даже быстрее):

ws.Range(Cells(firstRow, RowNumber), Cells(lastRow, Number))=twoDimensionalArray 

Где twoDimensionalArray является 2 одномерный массив из ваших some value значений, например,

Dim twoDimensionalArray(1 to [your last row], 1 to 12) as Long