Excel 代码运行缓慢，经常收到资源耗尽错误

每个月我都会收到一份大约5000行的账单记录，这被称为平面文件。在5000多行中有多种计费类型（读取计费服务）。所以我举个例子。客户A可以有18种不同的票据类型，客户B可以有25种。
每种票据类型有两行，一行是标题行，一行是数据行。每种票据类型都有不同的标题和列数。除前3项外，前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

子账单类型2（）
'清除以前数据的目标工作表
表格（“记录类型2摘要”）。激活
行（“2:2”）。选择
自动筛选
范围（“B3:I3”）。选择
范围（选择，选择。结束（xlDown））。选择
选择，清楚
'返回到源文件
工作表（“CGT_报告（3）”）。激活
行（“1:1”）。选择
Application.CutCopyMode=False
自动筛选
'为记录类型设置筛选器并删除标题行。
ActiveSheet.Range（“$A$1:$AL$14637”）。自动筛选字段：=3，标准1:=2
ActiveSheet.Range（“$A$1:$AL$14637”）。自动筛选字段：=4，标准1:=“*附件*”
范围（“A2:H2”）。选择
范围（选择，选择。结束（xlDown））。选择
选择，复制
'将结果粘贴回该记录类型的目标工作表
表格（“记录类型2摘要”）。激活
范围（“B3”）。选择
Selection.Paste特殊粘贴：=xlPasteValues，操作：=xlNone，SkipBlank_
：=假，转置：=假
第（3）列。NumberFormat=“mm/dd/yy”
范围（“C1”）.NumberFormat=“####”
如果范围（“C1”）>0，则
行（“2:2”）。选择
Selection.AutoFilter字段：=10，标准1:=“0”
如果结束

端接头

现在，我对大约35种其他票据类型进行了类似的处理，每种票据的标准略有不同。然后我把它们放在一个叫做runAll的大宏中，基本上我把所有35个宏都称为runAll

---

70%的时间运行良好。然而，在其他情况下，它要么永远持续下去，要么我会得到一个错误，表明我正在耗尽资源。如何提高效率？

我试着帮你清理一下，去掉

选择
和
激活
。还有一件事我没有研究，那就是检查行以确保它们是否已经自动过滤——如果您不确定它们的状态，这可能是一个问题

请注意，我们不是反复引用工作表，而是在开始时将它们分配给
sht1
和
sht2

这应该运行得更快（如果设置正确，我没有在我的计算机上测试）

子账单类型2（）
“跑快点
Application.ScreenUpdating=False
Application.Calculation=xlCalculationManual
'在此处设置一些lastrow值
将sht1标注为工作表，sht2标注为工作表，最后一行的长度为
Set sht1=此工作簿。工作表（“记录类型2摘要”）
设置sht2=ThisWorkbook.Worksheets（“CGT\U报告（3）”）
lastrow=sht.Cells（sht.Rows.Count，“B”）.End（xlUp）.Row
'清除以前数据的目标工作表
sht1.行（“2:2”）.自动筛选
sht1.Range（“B3:I”和lastrow）.ClearContents
'返回到源文件
lastrow=sht2.Cells（sht2.Rows.Count，“A”）.End（xlUp.Row）
sht2.行（“1:1”）.自动筛选
'为记录类型设置筛选器并删除标题行。
sht2.Range（$A$1:$AL$”&lastrow）。自动筛选字段：=3，标准1:=2
sht2.Range（$A$1:$AL$”&lastrow）。自动筛选字段：=4，标准1:=“*附件*”
lastrow=sht2.Cells（sht.Rows.Count，“A”）.End（xlUp）.Row
sht1.范围（“B3:I”&lastrow+1）。值=_
sht2.范围（“A2:H”和lastrow）.值
sht1.列（3）.NumberFormat=“mm/dd/yy”
sht1.Range（“C1”）.NumberFormat=“####”
如果sht1.范围（“C1”）>0，则
sht1.行（“2:2”）。自动筛选字段：=10，标准1:=0
如果结束
Application.ScreenUpdating=True
Application.Calculation=xlCalculationAutomatic
端接头
我试着帮你清理一下，去掉
选择
和
激活
。还有一件事我没有研究，那就是检查行以确保它们是否已经自动过滤——如果您不确定它们的状态，这可能是一个问题

请注意，我们不是反复引用工作表，而是在开始时将它们分配给
sht1
和
sht2

这应该运行得更快（如果设置正确，我没有在我的计算机上测试）

子账单类型2（）
“跑快点
Application.ScreenUpdating=False
Application.Calculation=xlCalculationManual
'在此处设置一些lastrow值
将sht1标注为工作表，sht2标注为工作表，最后一行的长度为
Set sht1=此工作簿。工作表（“记录类型2摘要”）
设置sht2=ThisWorkbook.Worksheets（“CGT\U报告（3）”）
lastrow=sht.Cells（sht.Rows.Count，“B”）.End（xlUp）.Row
'清除以前数据的目标工作表
sht1.行（“2:2”）.自动筛选
sht1.Range（“B3:I”和lastrow）.ClearContents
'返回到源文件
lastrow=sht2.Cells（sht2.Rows.Count，“A”）.End（xlUp.Row）
sht2.行（“1:1”）.自动筛选
'为记录类型设置筛选器并删除标题行。
sht2.Range（$A$1:$AL$”&lastrow）。自动筛选字段：=3，标准1:=2
sht2.Range（$A$1:$AL$”&lastrow）。自动筛选字段：=4，标准1:=“*附件*”
lastrow=sht2.Cells（sht.Rows.Count，“A”）.End（xlUp）.Row
sht1.范围（“B3:I”&lastrow+1）。值=_
sht2.范围（“A2:H”和lastrow）.值
sht1.列（3）.NumberFormat=“mm/dd/yy”
sht1.Range（“C1”）.NumberFormat=“####”
如果sht1.范围（“C1”）>0，则
sht1.行（“2:2”）。自动筛选字段：=10，标准1:=0
如果结束
Application.ScreenUpdating=True
Application.Calculation=xlCalculationAutomatic
端接头
清除所有
。选择
和
。激活
请参阅：您还可以在顶部将屏幕更新和计算设置为手动，然后在最后重置。清除所有
。选择
和
。激活
请参阅：您还可以在顶部将屏幕更新和计算设置为手动，然后在最后重置。我修复了一些类型
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