从 Excel 文件中获取数据的最快方法是什么？答案

【问题标题】：What's the fastest way to get data from an Excel file?从 Excel 文件中获取数据的最快方法是什么？
【发布时间】：2018-12-17 07:35:15
【问题描述】：

我的任务是从数千个 Excel 文件中复制 F1:F200 范围，并将它们粘贴到目标文件夹中的相邻列中。宏有效，但打开每个文件大约需要 5 秒。

我想过“获取数据”查询功能，但我不熟悉。我什至无法确定是否可以导入单个范围并将其粘贴到您需要的位置。

还有其他加快流程的方法吗？

（我看到了这个帖子：Read Excel file without opening it and copy contents on column first blank cell，但我不能再尝试 12 个小时。我希望到那时，有人会告诉我它肯定更快，或者肯定更慢，或者其他什么。）

编辑：我认为说“打开、复制和粘贴”足以描述该过程，但最好向您展示：

Sub LoopThroughFiles()
Dim StrFile As String
Dim aBook As Workbook, DestSheet As Worksheet
Dim dest As Range
Dim CurDir As String
Dim diaFolder As FileDialog

Set DestSheet = ThisWorkbook.Sheets("data modified")


' Chose directory 
MsgBox "Select Folder"
' Open the file dialog
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
'FIX: how to make the current directory the default for diaFolder?
diaFolder.AllowMultiSelect = False
diaFolder.Show

'This captures the Folder pathname
CurDir = diaFolder.SelectedItems(1)

ChDir CurDir
'cleanup
Set diaFolder = Nothing

StrFile = Dir(CurDir & "\*.xls")    
Dim aCell As Range

Do While Len(StrFile) > 0

    ' First cell of destination range
    DestSheet.Range("T4").End(xlToRight).Offset(-3, 1).Select
    'Open a workbook
    Set aBook = Workbooks.Open(Filename:=StrFile, ReadOnly:=True)

    ' Copy from Column F and the Paste
    aBook.Sheets(1).Range("F1", Range("F65536").End(xlUp)).Copy 
    DestSheet.Paste

    ' Close the book
    aBook.Application.CutCopyMode = False
    aBook.Close SaveChanges:=False

    StrFile = Dir
Loop


MsgBox "Done"

【问题讨论】：

你说只需要200个为什么要复制到65536？源文件有多大？他们所在的磁盘有多快？他们是通过网络吗？你能把它们放在本地快盘上吗？
What's the fastest way to get data from an Excel file? 使用 OLEDB
@Dy.Lee：好的。让我们等待 OP 响应，如果需要，我将发布代码 :) 顺便说一句，您可以使用 Set rsTbl = conn.OpenSchema(adSchemaTables) 然后循环通过它以使用 If Right(rsTbl.Fields!Table_Name.Value, 1) = "$" Then 获取工作表名称以获取工作表名称
@SiddharthRout，我已经测试了你的代码，这是一个很好的方法。
@Dy.Lee：为此你必须使用 DAO。 DAO 是唯一一个通过工作簿Set wb = daoEngn.OpenDatabase("C:\Users\routs\Desktop\AB-Retainership\test.xls", False, True, "Excel 8.0;") 和For Each tbl In wb.TableDefs 中的序号位置检索工作表名称的库，以获取tbl.Name

标签： excel vba import

【解决方案1】：

这应该会快一点

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim target As Range
Set target = DestSheet.Range("T4").End(xlToRight).Offset(-3, 1)

Do While Len(StrFile) > 0


    'Open a workbook
    Set aBook = Workbooks.Open(Filename:=StrFile, ReadOnly:=True)

    ' Copy from Column F and then Paste
    aBook.Sheets(1).Range("F1:F200").Copy
    target.PasteSpecial xlPasteAll

    ' Close the book
   ' aBook.Application.CutCopyMode = False 'not needed
    aBook.Close SaveChanges:=False
 Set target = target.Offset(0, 1) 'move pointer 1 column right
    StrFile = Dir
Loop

【讨论】：

我可以看到前两行的优势。并使用 Target.Offset。我试试看。

【解决方案2】：

这是一种使用oledb的方法。

Dim Rs As Object

Sub LoopThroughFiles()
    Dim StrFile As String
    Dim aBook As Workbook, DestSheet As Worksheet
    Dim dest As Range
    Dim CurDir As String
    Dim diaFolder As FileDialog
    Dim Fn As String
    Dim Target As Range
    Dim strSQL As String

    Set DestSheet = ThisWorkbook.Sheets("data modified")


    ' Chose directory
    MsgBox "Select Folder"
    ' Open the file dialog
    Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
    'FIX: how to make the current directory the default for diaFolder?
    diaFolder.AllowMultiSelect = False
    diaFolder.Show

    'This captures the Folder pathname
    CurDir = diaFolder.SelectedItems(1)

    ChDir CurDir
    'cleanup
    Set diaFolder = Nothing

    StrFile = Dir(CurDir & "\*.xls")
    Dim aCell As Range

    strSQL = "Select * from [Report$F1:F65536] "

    Do While Len(StrFile) > 0
        Fn = CurDir & "\" & StrFile
        ' First cell of destination range
        Set Target = DestSheet.Range("T4").End(xlToRight).Offset(-3, 1)
        getRs Fn, strSQL
        Target.CopyFromRecordset Rs
        Rs.Close
        Set Rs = Nothing

        StrFile = Dir
    Loop


    MsgBox "Done"
End Sub

Sub getRs(Fn As String, strQuery As String)
    Dim strConn As String

    strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & Fn & _
             ";Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"";"

    Set Rs = CreateObject("ADODB.Recordset")
    Rs.Open strQuery, strConn

End Sub

【讨论】：