我试图自动化一个包含5个不同信息源的报告。我试图使用ListObjects将不同表的UNION组成一个表,一切正常,除非我复制第一个ListObject的第一列。复制第一列大约需要2分钟,下一列只需不到1秒。
每次运行VBA脚本时,我都会删除目标表的所有行,以使用带有0行的ListObject启动VBA脚本。
我会尝试解释它的工作原理:
Sub ProcesarPresupuesto()
'This is the first macro that process and copy the information of the first source
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
'<Here> I add several columns and process the information of this first source, I keep all the rows as values using the Function: AddColumnFormula (at the end of this example). I think this is not causing the problem.
'Then I fill all the Blanks Cells to avoid having empty cells in my final table.
Sheets("Origin").Select
Selection.CurrentRegion.Select
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "Null"
On Error GoTo 0
'When I have the ListObject ready I start copying the columns to the destination
Sheets("Destination").Select
Range("A1").Select
While ActiveCell.Value <> ""
Call CopyColumn("Origin", ActiveCell.Value, "Destination")
ActiveCell.Offset(0, 1).Select
Wend
End Sub
我认为这应该非常快。如果我只删除Destination ListObject的值并保持行为空,则立即复制第一列,因此我认为问题与Excel如何计算要添加到ListObject的第一行有关。当表为空时,是否有更好的方法来复制列?我做错了什么?。
这是Function CopyColumn
Function CopyColumn(Origin, ColumnName, Destination)
Range(Origin & "[[" & ColumnName & "]]").Copy Destination:=Range(Destination & "[[" & ColumnName & "]]")
End Function
这是我用来处理列的函数
Function AddColumnFormula(DestinationSheet, TableName, ColumnName, Value)
Set NewColumn = Sheets(DestinationSheet).ListObjects(TableName).ListColumns.Add
NewColumn.Name = ColumnName
Set Rango = Range(TableName & "[[" & ColumnName & "]]")
Rango.Value = Value
Rango.Copy
Rango.PasteSpecial (xlPasteValues)
End Function
提前感谢您的时间和答案
答案 0 :(得分:3)
我使用您提供的文件进行了一些测试。它很慢但我最初没有时间。我看到了一些修改可能提高性能的代码的机会,计时器耗时1分16秒。
我尝试了一些不同的成功,使用Debug.Print
语句来告诉我代码的哪些部分正在运行以及它们需要多长时间。大多数处决都是每次约2分钟,最慢的是3分13秒。
在最后3分13秒的尝试中,我将注意力集中在:
...CurrentRegion.SpecialCells(xlCellTypeBlanks)
这是可疑的,因为CurrentRegion
和SpecialCells
方法都很昂贵。将它们结合起来似乎是灾难的一种方法。
我想我会尝试一个简单的迭代,只是为了比较性能,令我惊讶的是,我能够在42,000行和32列数据上做一个简单的For each
循环,这将在大约14秒,总运行时间约为30秒。
以下是我用于循环的代码:
Dim cl As Range
'Debug.Print "For each ..." & Format(Now(), "hh:mm:ss")
For Each cl In wsP.ListObjects(1).DataBodyRange
If cl.Value = vbNullString Then cl.Value = "Null"
Next
'Debug.Print "End loop " & Format(Now(), "hh:mm:ss")
以下是我的最后三个结果:
31 seconds:
Commencar a 21:09:25
For each ...21:09:38
End loop 21:09:52
CopiarColumnaListOBjectaVacia...21:09:52
Finito : 5/5/2014 9:09:56 PM
30 seconds:
Commencar a 21:10:23
For each ...21:10:36
End loop 21:10:49
CopiarColumnaListOBjectaVacia...21:10:49
Finito : 5/5/2014 9:10:53 PM
34 seconds:
Commencar a 21:18:42
For each ...21:18:55
End loop 21:19:09
CopiarColumna... 21:19:09
Finito : 5/5/2014 9:19:16 PM
我已将修订版的XLSB保存在Google文档中,以便您可以完整地查看。
https://drive.google.com/file/d/0B1v0s8ldwHRYZWhuTmRuaDJoMzQ/edit?usp=sharing
正如我所说,我确实对这个子程序和RenombraColumna
进行了一些更改,但事后看来这些可能提供了一些效率,我认为问题的根源是CurrentRegion.SpecialCells
。 / p>
我希望你不介意我修改这个问题的标题更适合特定的问题。如最初所述,这个问题不太可能帮助其他相同的症状。