0

このコードを使用して、閉じたワークブックのシートからコピー先のワークブックにすべてのデータをコピーしています。ただし、このコードは各セルをループし、ソース ワークブックには 40,000 行が含まれているため、時間がかかりすぎます。セルをループせずにソースワークシートから宛先ワークブックの特定のワークシートにすべてのデータをコピーするために、このコードにどのような変更を加えることができるか、または提供できる代替ソリューションがあるかどうかを教えてください。

Sub GetDataDemo() 

Dim FilePath$, Row&, Column&, Address$ 

Const FileName$ = "Book1.xls" 
Const SheetName$ = "Sheet1" 
Const NumRows& = 40000 
Const NumColumns& = 10 
FilePath = ActiveWorkbook.Path & "\" 
 '***************************************
     DoEvents 
Application.ScreenUpdating = False 
If Dir(FilePath & FileName) = Empty Then 
    MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist" 
    Exit Sub 
End If 
For Row = 1 To NumRows 
    For Column = 1 To NumColumns 
        Address = Cells(Row, Column).Address 
        dest. Cells(Row, Column) = GetData(FilePath, FileName, SheetName, Address) 
        Columns.AutoFit 
    Next Column 
Next Row 
ActiveWindow.DisplayZeros = False 
End Sub 


Private Function GetData(Path, File, Sheet, Address) 
    Dim Data$ 
    Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _ 
    Range(Address).Range("A1").Address(, , xlR1C1) 
    GetData = ExecuteExcel4Macro(Data) 
End Function
4

1 に答える 1

0

私はあなたのために良い/同様の解決策を見つけました：

http://social.msdn.microsoft.com/Forums/office/en-US/aa6edf0f-2007-4f25-885c-f03d3df4d853/pulling-values-from-closed-workbook-into-current-workbook-but-on-a-different-sheet

あなたの場合、次を置き換えます：

For Row = 1 To NumRows 
For Column = 1 To NumColumns 
Address = Cells(Row, Column).Address 
dest. Cells(Row, Column) = GetData(FilePath, FileName, SheetName, Address) 
Columns.AutoFit 
Next Column 
Next Row

と ：

For Row = 1 To NumRows
For Column = 1 To NumColumns
Address = Cells(Row, Column).Address
Cells(Row, Column + X) = GetDataEleven(FilePath, FileName, SheetName, Address)
Next Column
Next Row
Columns.AutoFit
于 2013-12-13T12:18:22.400 に答える