代码运行缓慢且经常收到Run out of Resources错误

时间:2018-02-23 17:51:21

标签: excel excel-vba vba

每个月我都会收到大约5,000行的结算记录,称为平面文件。在5,000多行内,有多种计费类型(读取可计费服务)。这样的例子。客户A可以有18种不同的账单类型,客户B可以有25种不同的账单类型 每种账单类型都有2行,标题行和数据行。每个帐单类型都有不同的标题和列数。除了第1个3,它始终是客户编号,日期,记录类型(账单类型)。此外,每种账单类型都需要有自己的工作表。

所以这就是我所做的。

Sub BillType2()

'Clearing the destination worksheet of previous data

Sheets("REC_type_2_summary").Activate
Rows("2:2").Select
Selection.AutoFilter
Range("B3:I3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Clear

'back to source file

Sheets("CGT_REPORT (3)").Activate
Rows("1:1").Select
Application.CutCopyMode = False
Selection.AutoFilter

'setting filter for record type and eliminating the header rows.

ActiveSheet.Range("$A$1:$AL$14637").AutoFilter Field:=3, Criteria1:="2"
ActiveSheet.Range("$A$1:$AL$14637").AutoFilter Field:=4, Criteria1:="<>*Exhibit*"

Range("A2:H2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

'Pasting result back to the destination sheet for that record type

 Sheets("REC_type_2_summary").Activate
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Columns(3).NumberFormat = "mm/dd/yy"
Range("C1").NumberFormat = "###"

If Range("C1") > 0 Then
Rows("2:2").Select
Selection.AutoFilter Field:=10, Criteria1:="<>0"
End If

End Sub

现在我使用大约35种其他账单类型进行类似的处理,每种账单类型的标准略有不同。然后我把它们放在一个名为runAll的大宏中,这基本上就是我调用所有35个宏。

70%的时间它运行良好。然而,其他时候它要么永远或我会得到错误,表明我的资源不足。如何提高效率?

1 个答案:

答案 0 :(得分:3)

我为你清理了一下,摆脱了SelectActivate。我没有考虑的另一件事是检查行以确定它们是否已经自动过滤 - 如果你不确定它们的状态,这可能是一个问题。

请注意,我们不是一遍又一遍地引用工作表,而是在开始时将它们分配给sht1sht2

这应该更快地运行(如果设置正确,我没有在我的计算机上测试)。

Sub BillType2()

'Run faster
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'Get some lastrow values set up here
Dim sht1 As Worksheet, sht2 As Worksheet, lastrow As Long
Set sht1 = ThisWorkbook.Worksheets("REC_type_2_summary")
Set sht2 = ThisWorkbook.Worksheets("CGT_report (3)")
lastrow = sht.Cells(sht.Rows.Count, "B").End(xlUp).Row

'Clearing the destination worksheet of previous data
sht1.Rows("2:2").AutoFilter
sht1.Range("B3:I" & lastrow).ClearContents

'back to source file

lastrow = sht2.Cells(sht2.Rows.Count, "A").End(xlUp).Row

sht2.Rows("1:1").AutoFilter

'setting filter for record type and eliminating the header rows.

sht2.Range("$A$1:$AL$" & lastrow).AutoFilter Field:=3, Criteria1:="2"
sht2.Range("$A$1:$AL$" & lastrow).AutoFilter Field:=4, Criteria1:="<>*Exhibit*"

lastrow = sht2.Cells(sht.Rows.Count, "A").End(xlUp).Row

sht1.Range("B3:I" & lastrow + 1).Value = _
sht2.Range("A2:H" & lastrow).Value

sht1.Columns(3).NumberFormat = "mm/dd/yy"
sht1.Range("C1").NumberFormat = "###"

If sht1.Range("C1") > 0 Then
    sht1.Rows("2:2").AutoFilter Field:=10, Criteria1:="<>0"
End If

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub