Slow VBA macro writing in cells

纵然是瞬间 提交于 2019-11-29 04:49:50

Would it be possible, to write in a whole row, instead of the single cells? Would that be faster?

Yes and yes. This is exactly where you can improve performance. Reading/writing to cells is notoriously slow. It matters very little how many cells you are reading/writing, but rather how many calls you are making to the COM object to do so. Therefore read and write your data in blocks utilizing two-dimensional arrays.

Here is an example procedure that writes MS Project task data to Excel. I mocked up a schedule with 29,000 tasks and this runs in a few seconds.

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

Do it like this:

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

Where arr is an array of your some value values e.g.

Dim arr(1 to 100) as Long

Or if possible (even faster):

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

Where twoDimensionalArray is a 2 dimensional array of your some value values e.g.

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

A previous answer mentions doing cells(1,1).select.

My suggestion is to do Worksheets("Sheet2").Activate before your update loop.

  • replace Sheet2 above with any sheet that isn't the one having cells updated. This results in a really substantial improvement.

  • even though you can set application displayupdating false, changing the activated sheet truly removes the overhead.

I was in a situation where I was populating huge table and I had to go cell by cell, then row by row. Painfully slow. I'm still not sure why but before my loop I added:

cells(1,1).select

(that is cell outside my table if that matters -idk) and speed was significantly improved. I mean from 10 minutes to about 30 sec. So if you are writing to cells in a table give it a go.

I should add that first thing I always do is disabling events, screen updates and switching to manual calculations. That did not helped before I tried this workaround

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!