时间戳

首页 > 解决方案 > Excel VBA 在 50k+ 行数据上执行 While 循环，处理 30+ 分钟

arrays - Excel VBA 在 50k+ 行数据上执行 While 循环，处理 30+ 分钟

问题描述

我正在一个带有 50k+ 行库存数据的大型 Excel 文件上运行 Do While 循环，并让宏对我的计算机（移动 i5 6300u，8gb ram）需要 40 分钟才能处理的数据进行排序（这就是重点我放弃并关闭了程序）。

有没有更好的方法来减少税收？我正在考虑让宏在第一行粘贴一个值并将其复制到最后一行，就像我手动粘贴值一样。

我对将数据转换为数组进行了一些研究，但还没有找到在类似的东西上运行 Do While 循环的东西。我没有使用数组及其应用程序的 VBA 经验。作为参考框架，我有在 R 中处理类似这样的东西的经验，这将是一件轻而易举的事，但我办公室里没有人使用它，所以我必须使用 VBA。

任何帮助表示赞赏！

Sub AutoINV()
Dim row
Dim lastrow
Dim x As Workbook
Dim y As Workbook

'## Open workbook first:
Set x = Workbooks.Open("x.xls")
Set y = Workbooks.Open("y.xlsx")

    x.Sheets("x.xls").Range("A1:aa60000").Copy
    Windows("y.xlsx").Activate
    Range("A1").Select
    ActiveSheet.Paste

'Close x:
x.Close


row = 2
lastrow = Sheets("Inv_Datatable").Range("a100000").End(xlUp).row
Set x = Workbooks.Open("y.xlxs")

Do While row <= lastrow
'1DIG LBL
If Left(y.Sheets("Inv_Datatable").Range("Z" & row), 2) = "RM" Then
y.Sheets("Inv_Datatable").Range("AB" & row) = ""
Else: y.Sheets("Inv_Datatable").Range("AB" & row) = Right(y.Sheets("Inv_Datatable").Range("Af" & row), 1)
End If
y.Sheets("Inv_Datatable").Range("ad" & row) = Left(y.Sheets("Inv_Datatable").Range("h" & row), 5) 'Lic
y.Sheets("Inv_Datatable").Range("ae" & row) = Application.VLookup(y.Sheets("Inv_Datatable").Range("Af" & row), x.Worksheets("StyleMaster").Range("a1:az40000"), 26, 0) 'RMUPC
y.Sheets("Inv_Datatable").Range("af" & row) = y.Sheets("Inv_Datatable").Range("i" & row) & y.Sheets("Inv_Datatable").Range("j" & row) 'Full Style
'Country
If (Left(y.Sheets("Inv_Datatable").Range("Ac" & row), 1) = "D" And Right(y.Sheets("Inv_Datatable").Range("Ac" & row), 1) = "S") Or (Left(y.Sheets("Inv_Datatable").Range("Ac" & row), 1) = "D" And Right(y.Sheets("Inv_Datatable").Range("Ac" & row), 1) = "C") Then
y.Sheets("Inv_Datatable").Range("Ac" & row) = "USA"
Else:
If Left(y.Sheets("Inv_Datatable").Range("Ac" & row), 1) = "D" Or Left(y.Sheets("Inv_Datatable").Range("Ac" & row), 1) = "C" Then
y.Sheets("Inv_Datatable").Range("Ac" & row) = "CAN"
Else: y.Sheets("Inv_Datatable").Range("Ac" & row) = "USA"
End If
End If
y.Sheets("Inv_Datatable").Range("ag" & row) = Mid(y.Sheets("Inv_Datatable").Range("af" & row), 2, 1) & "_" 'Mid 2,1
y.Sheets("Inv_Datatable").Range("ah" & row) = y.Sheets("Inv_Datatable").Range("ag" & row) & y.Sheets("Inv_Datatable").Range("g" & row) 'Code
    If y.Sheets("Inv_Datatable").Range("ac" & row) = "CAN" And Left(y.Sheets("Inv_Datatable").Range("af" & row), 1) = "C" Then
    y.Sheets("Inv_Datatable").Range("u" & row) = ""
    row = row + 1
    Else: row = row + 1
    End If
Loop

ActiveWorkbook.RefreshAll

End Sub

标签： arraysexcelvbado-while

解决方案

在循环之前，禁用一些项目：

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

循环后启用：

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

推荐阅读