4

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 に追加される最初の行を計算する方法に問題があると思います。テーブルが空のときに列をコピーするより良い方法はありますか? 私は本当に間違ったことをしていますか？

これは関数 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

お時間とご回答ありがとうございます。

4

1 に答える 1

3

ご提供いただいたファイルでテストを行いました。遅かったけど、最初は間に合わなかった。パフォーマンスを向上させる可能性のあるコードを修正する機会がいくつかあり、タイマーは 1 分 16 秒かかりました。

ステートメントを使用しDebug.Printて、コードのどの部分が実行されていて、どれくらいの時間がかかっているかを知らせてくれました。ほとんどの実行はそれぞれ約 2 分で、最も遅い実行は 3 分 13 秒でした。

その最後の 3 分 13 秒の試みで、私は次のことに焦点を絞りました。

...CurrentRegion.SpecialCells(xlCellTypeBlanks)

CurrentRegionメソッドとSpecialCellsメソッドの両方が高価になる可能性があるため、これは疑わしいものです。それらを組み合わせると、災害のレシピのように思えました。

パフォーマンスを比較するためだけに簡単な反復を試してみようと考えたところ、驚いたことに、For each42,000 行と 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")

これが私の最後の3つの結果です。

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。

この質問のタイトルを特定の問題により適したものに変更したことを気にしないでください。最初に述べたように、質問は同じ症状を持つ他の人を助ける可能性は低い.

于 2014-05-06T01:28:17.533 に答える