我怎样才能减less与Excel VBA的处理时间

我正在使用excel vba 2010在已经存在的工作簿中创build两个电子表格。 这些新电子表格的来源是另一个有12个电子表格的工作簿（每个电子表格有40000行），这是我第一次创build这两个电子表格需要2个多小时。 （我select了aprox 13000行来创build这两个电子表格）。 我怎样才能减less时间消耗？

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

在代码运行时closures屏幕更新和计算通常是有帮助的，可以这样做：

 Application.ScreenUpdating = False Application.Calculation = xlCalculationManual 'Your code goes here Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True 

这里和这里是一些很好的文章，进入一些其他的VBA最佳实践的速度。

Answer 2

另外，如果您不想触发Sheet_Change和Workbook_change，则每次更改单个单元格的值时，都会添加

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

但是如果你的代码因为错误/debugging而停下来，要小心，你将需要再次启用事件（取决于是否需要事件来执行其他操作）