PDA

View Full Version : Vba far loop too slow



s20011301
07-25-2017, 10:00 AM
For i = 1 To 18
For j = 1 To 31

Sheets("ABS").Cells(i, j + 1).Value =
Workbooks(getfilename).Sheets(orgsheet).Cells(i * 15 - 9, 8 + j).Value + _
Workbooks(getfilename).Sheets(orgsheet).Cells(i * 15 + 3, 8 + j).Value

Next j
Next i


It took 8 seconds to finish. How to improve the codes?

mdmackillop
07-25-2017, 10:26 AM
I don't know what else is going on. This took 0.074 seconds with integers and 0.14 seconds with 16 significant figures

Sub Test()
tim = Timer
getfilename = "Data.xlsx"
orgsheet = "Sheet1"
With Workbooks(getfilename).Sheets(orgsheet)
For i = 1 To 18
For j = 1 To 31
Worksheets("ABS").Cells(i, j + 1).Value = _
.Cells(i * 15 - 9, 8 + j).Value + _
.Cells(i * 15 + 3, 8 + j).Value
Next j
Next i
End With
MsgBox Timer - tim
End Sub

Leith Ross
07-25-2017, 11:18 AM
Hello s20011301,

Here is another method you can try. This first reads all the values into an array that is 18 x 31. The output range is resized to match the array and the array is output to the range in a single block transfer. With a small data set like this, you may not see any real speed again. However, with larger data sets you can see significant gains.

If you have formulas, did you set formula calculation to manual before running your macro?


Sub TestA()


Dim Data As Variant
Dim dstWks As Worksheet
Dim i As Long
Dim j As Long
Dim srcWkb As Workbook
Dim srcWks As Worksheet


Set srcWkb = Workbooks(getfilename)
Set srcWks = srcWkb.Worksheets(orgsheet)

Set dstWks = ThisWorkbook.Worksheets("ABS")

ReDim Data(1 To 18, 1 To 31)

For i = 1 To 18 * 15 Step 15
For j = 9 To 39
Data(i, j) = srcWks.Cells(i - 9, j) + srcWks.Cells(i + 3, j)
Next j
Next i

dstWks.Cells(1, 2).Resize(18, 31).Value = Data


End Sub

mana
07-26-2017, 04:18 AM
Application.Calculation = xlCalculationManual
your code
Application.Calculation = xlCalculationAutomatic

snb
07-26-2017, 04:41 AM
Sub M_snb()
sheets("ABS").[A1:AD255]=[org!I6:AM261+org!I18:AM273]
End sub

p45cal
07-26-2017, 06:54 AM
mdmackillop's 'I don't know what else is going on' is probably calculations as the destination sheet has values added to it cell by cell, so mana's suggestion will probably suffice.
Leith Ross' suggestion should be very fast since it plonks all the new data in place in one shot, however it still picks the data off the source sheet cell by cell resulting in many sheet accesses which might slow things up, albeit only a little.
It would be faster to have one read access and one write access for the whole process, something along the lines of:
sce = Workbooks(getfilename).Sheets(orgsheet).Range("I6:AM273").Value 'one read access
Dim res(1 To 18, 1 To 31)
rw = 1
For r = 1 To UBound(sce) Step 15
For c = 1 To 31
res(rw, c) = sce(r, c) + sce(r + 12, c)
Next c
rw = rw + 1
Next r
Sheets("ABS").Range("B1:AF18") = res 'one write access

Time trials support this.
snb's won't work well since the OP needs every 15th row of [org!I6:AM261+org!I18:AM273], not every row.

s20011301
07-28-2017, 11:24 PM
Thank you all of you. I find out the main reason is I haven't set formula calculation to manual.