Excel CurrentRegion.SpecialCells（xlCellTypeVisible）太慢-提高性能的提示？

我正在尝试自动化一个包含5个不同信息源的报告。我正在尝试使用ListObjects将不同的表合并成一个表，除了复制第一个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

这是我用来处理列的函数

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

---

提前感谢您的时间和回答

我用您提供的文件做了一些测试。它很慢，但我一开始没有计时。我看到了一些修改代码的机会，这可能会提高性能，计时器花了1分16秒

我尝试了更多的方法，但都取得了不同的成功，使用

Debug.Print

语句来通知我代码的哪个部分正在运行，以及它们运行了多长时间。大多数死刑每次执行约2分钟，最慢为3分钟13秒

在最后的3m13s尝试中，我将注意力集中在：

…CurrentRegion.SpecialCells（xlCellTypeBlanks）

这是可疑的，因为

CurrentRegion

和

SpecialCells

方法都可能很昂贵。把它们结合起来似乎是一种灾难

我想我会尝试一个简单的迭代，只是为了比较性能，令我惊讶的是，我能够对42000行和32列数据的每个循环执行一个简单的

，这将在大约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的修订版保存在谷歌文档中，以便您可以完整地查看


正如我所说，我确实对这个子程序和
RenombraColumna
做了一些更改，但事后看来，虽然这些更改可能会提供一些效率，但我认为问题的根源在于
CurrentRegion.SpecialCells

我希望大家不要介意，我修改了这个问题的标题，使之更适合具体问题。如前所述，该问题不太可能帮助其他具有相同症状的患者。
该范围的地址是什么<代码>范围（原点和“[[”&列名和“]]”

？添加

MsgBox范围（Origin&“[[”&ColumnName&“]]”）。地址
让我们看看它显示了什么。感谢@DavidZemens的帮助，它为我提供了范围（$A$2:$A$42174），这是源代码中第一列的范围。看起来还可以。我正在45000行数据上运行您的代码，复制7列（ScreenUpdate=False）只需不到一秒钟，ScreenUpdate=True只需不到2秒钟……嗨@DavidZemens，我在周末尝试过这方面的工作，但我并不幸运。这是我的文件的一个例子。我删除了一些不用于此宏的工作表。奇怪的是，当我在另一台计算机上测试它时，它工作得更好，但仍然很慢。宏名为：ProcesarPresupuesto，它位于模块“GenerarReporte”中。我运行过一次，速度有点慢，但没有计时。然后我对进程arprepuesto做了一些更改，花了1 m16秒。我尝试了更多的方法，取得了不同程度的成功，最近一次用了3m13秒，但大多数执行时间都是2分钟左右。在那次尝试中，我加入了一些Debug.Print语句，我认为问题出在
…CurrentRegion.SpecialCells（xlCellTypeBlanks）
——这条语句花了2m53s来计算。我会再看一会儿，但我认为这是罪魁祸首：
CurrentRegion
和
specialcell
都是昂贵的操作。也许有更好的方法可以做到这一点。
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