将已关闭工作簿中的大数据复制到目标工作簿中的特定工作表答案

【问题标题】：Copy large data from closed workbook to a specific worksheet in destination workbook将已关闭工作簿中的大数据复制到目标工作簿中的特定工作表
【发布时间】：2013-12-13 20:18:22
【问题描述】：

我正在使用此代码将所有数据从已关闭工作簿中的工作表复制到目标工作簿。但是，此代码循环遍历每个单元格，并且由于源工作簿包含 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

【问题讨论】：

也许THIS 帖子是您需要的？我没有办法比较执行时间。这篇文章从Range 的封闭工作表中提取数据，而不使用ExecuteExcel4Macro。
您是否尝试过打开已关闭的工作簿？打开关闭的工作簿并复制整个范围而不循环可能会快得多
@l42 ..感谢范围公式运行良好。
@Charles.. 我不能使用打开的工作簿，因为我不希望最终用户看到从中导入信息的工作簿
你们能告诉我是否有一种方法可以在不打开源 workbbok 的情况下导入数据透视表。范围公式以表格形式获取数据，我正在尝试导入数据透视表。我可以使用 workbook.open 公式来完成，但我需要知道是否可以从封闭的工作簿中完成。谢谢

标签： excel vba

【解决方案1】：

我在链接上为您找到了好的/类似的解决方案：

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

【讨论】：