如何使用excel vba减少处理时间 [英] how can i reduce the process time with excel vba

问题描述

我正在使用excel vba 2010在一个已经存在的工作簿中创建两个电子表格.这些新电子表格的来源是另一本包含12个电子表格的工作簿(每个工作簿具有40000行)，这是我第一次创建这两个电子表格所用的时间超过2个小时.(我选择了约13000行来创建这两个电子表格).如何减少时间消耗?

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

推荐答案

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

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.

这篇关于如何使用excel vba减少处理时间的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！