如何使用excel vba减少处理时间

Question

I am using excel vba 2010 to create two spreadsheets in a workbook that already exists. The source for these new spreadsheets is another workbook with 12 spreadsheets (each one with 40000 rows) the first time that I am creating these two spreadsheets took more than 2 hours. (I have chosen aprox. 13000 rows to create these two spreadsheets). How can I reduce the time consumption?

Sub creaInventarios(wkArchivoROT, wkArchivoDatos)

Dim book_I As Workbook, wbk1 As Workbook
Dim sheet_IQB As Worksheet, sheet_I As Worksheet, sheet_P As Worksheet, sheet_FIN As Worksheet
Dim longitudCampo As Integer
Dim nf As Long, nfo As Long, orden As Long, divida As Long, queda As Long, nf1 As Long, canrow As Long
Dim chkInventario As String

Dim texto As Range
Dim codigoItem As Range
Dim descrItem As Range
Dim itemVendedor As Range
Dim puntoReorden As Range
Dim qtyOnHand As Range
Dim qtyOnSale As Range
Dim qtyAvailable As Range
Dim suggestReorden As Range
Dim qtyReorden As Range
Dim earlySale As Range
Dim salesThisWeek As Range

Dim errorCampo As Boolean

Set book_I = Workbooks.Open(wkArchivoROT)

Set sheet_I = book_I.Worksheets(9)
Set sheet_P = book_I.Worksheets(8)

Set wbk1 = Workbooks.Open(wkArchivoDatos)
Set sheet_FIN = wbk1.Worksheets("Final")
nf = 3
nfo = 7
orden = 0

lee_Fin:

If sheet_FIN.Range("C" & nf) = " " Or sheet_FIN.Range("C" & nf) = vbNullString Then
    If sheet_FIN.Range("B" & nf).Value = " " Or sheet_FIN.Range("B" & nf) = vbNullString Then
        GoTo finInventario
    End If
End If
queda = Len(sheet_FIN.Range("C" & nf).Value)
If queda = 0 Then
    nf = nf + 1
    GoTo lee_Fin
End If
Set codigoItem = sheet_FIN.Range("C" & nf)
chkInventario = Mid(codigoItem.Value, 1, 3)
If chkInventario = "MPA" Or chkInventario = "MPC" Or chkInventario = "PPA" Or chkInventario = "PTC" Then
    GoTo checkIgual
Else
    nf = nf + 1
    GoTo lee_Fin
End If

checkIgual:

Set texto = sheet_FIN.Range("B" & nf)

Set descrItem = sheet_FIN.Range("D" & nf)
Set itemVendedor = sheet_FIN.Range("E" & nf)
Set puntoReorden = sheet_FIN.Range("F" & nf)
Set qtyOnHand = sheet_FIN.Range("G" & nf)
Set qtyOnSale = sheet_FIN.Range("H" & nf)
Set qtyEnsamble = sheet_FIN.Range("I" & nf)
Set qtyAvailable = sheet_FIN.Range("J" & nf)
Set suggestReorden = sheet_FIN.Range("L" & nf)
Set qtyReorden = sheet_FIN.Range("M" & nf)
Set earlySale = sheet_FIN.Range("N" & nf)
Set salesThisWeek = sheet_FIN.Range("O" & nf)

sheet_P.Range("A" & nfo).Value = codigoItem.Value
sheet_I.Range("A" & nfo).Value = codigoItem.Value

sheet_P.Range("B" & nfo).Value = descrItem.Value
sheet_I.Range("B" & nfo).Value = descrItem.Value

sheet_P.Range("C" & nfo).Value = puntoReorden.Value

sheet_I.Range("C" & nfo).Value = qtyOnHand.Value
sheet_P.Range("D" & nfo).Value = qtyOnHand.Value

'sheet_I.Range("C" & nfo).Value = qtyAvailable.Value
'sheet_P.Range("D" & nfo).Value = qtyAvailable.Value

sheet_I.Range("D" & nfo).Value = qtyOnSale.Value
sheet_P.Range("E" & nfo).Value = qtyOnSale.Value

sheet_I.Range("E" & nfo).Value = qtyEnsamble.Value * -1
sheet_P.Range("F" & nfo).Value = qtyEnsamble.Value * -1

sheet_I.Range("F" & nfo).Value = qtyAvailable.Value
sheet_P.Range("G" & nfo).Value = qtyAvailable.Value

orden = orden + 1
sheet_I.Range("U" & nfo).Value = orden
sheet_P.Range("L" & nfo).Value = orden
nfo = nfo + 1
nf = nf + 1
GoTo lee_Fin

finInventario:
MsgBox "Continuar", vbInformation, "WARNING"
End Sub

Answer 1

Turning off screen updating and calculation while your code is running is usually helpful, and can be done like so:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'Your code goes here

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Here and here are some good articles that go into a number of other VBA best practices for speed.

Answer 2

Also if you don't want to trigger Sheet_Change and Workbook_change, each ime you change the value of a single cell, add

application.enableevents=false
' your code here
application.enableevent=true

but be careful if your code stops for error/debugging, you will need to enableevents again (depending if events are needed for other actions)