Question

我正在一个大型的excel文件上运行Do While循环，该文件具有超过50k行的库存数据，并且宏要对数据进行排序，这需要40分钟以上的时间来处理我的计算机（移动i5 6300u，8GB ram）是我放弃并关闭程序的地方。

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

我已经研究了一些将数据转换为数组的方法，但是还没有找到在类似的方法上运行Do While循环的方法。我没有VBA w /阵列及其应用经验。作为参考，我有在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

Answer 1

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

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

在循环后启用：

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

Excel VBA做While循环处理50k +行数据，需要30+分钟来处理

1 个答案: