Question

我正在使用excel vba 2010在已存在的工作簿中创建两个电子表格。这些新电子表格的来源是另一个包含12个电子表格的工作簿（每个电子表格包含40000行），这是我第一次创建这两个电子表格时间超过2小时。（我选择了aprox。13000行来创建这两个电子表格）。如何减少耗时？

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

在代码运行时关闭屏幕更新和计算通常很有用，可以这样做：

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'Your code goes here

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Here和here是一些很好的文章，这些文章介绍了许多其他VBA最佳速度方法。

Answer 2

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

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

但是如果您的代码因错误/调试而停止，请小心，您需要再次启用事件（取决于其他操作是否需要事件）

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

2 个答案: