从多个Excel文件中提取数据到一个数据表或文件中

Question

我有100多个.xlsx文件，每个文件都有两个表格。第一个表格（始终称为sts）通常有15-20万行，其中有一个名为“ Code”的列。第二个表格（始终称为cps）大约有85k行，也有相同的Code列。

我需要从表格sts中提取特定代码的所有行，放入一个表格/工作表中，并从表格cps中提取特定代码的所有行，放入第二个表格/工作表中。我需要对所有文件执行此操作。

我尝试了两种方法：

1）使用Excel VBA打开每个文件，使用自动筛选器将所需的代码行复制到主工作簿进行汇总。使用以下代码从预定义的起始目录获取文件并进一步搜索：Public Sub SearchFiles()。

Public Sub SearchFiles()

'Macro to start the file extraction by drilling down from the mydir path specified
Dim code As String
Dim time1 As Double
Dim time2 As Double

Range("a1").Value = InputBox("Please type code to extract", code)
time1 = Timer

myFileSearch _
myDir:="C:\Data\Dashboard\2014\New Files Excel Loop", _
FileNameLike:="Reporting", _
FileTypeLike:=".xlsx", _
SearchSubFol:=True, _
myCounter:=0

time2 = Timer
MsgBox time2 - time1 & "seconds"

End Sub


Private Sub myFileSearch(myDir As String, FileNameLike As String, FileTypeLike As String, _
  SearchSubFol As Boolean, myCounter As Long)
Dim fso As Object, myFolder As Object, myFile As Object
Dim Rowcount As Long
Dim rowcount2 As Long
Dim masterbook As Workbook
Set masterbook = ThisWorkbook
Set fso = CreateObject("Scripting.FileSystemObject")
Dim commodity As String

code = Range("a1").Value

Application.ScreenUpdating = False

For Each myFile In fso.GetFolder(myDir).Files
    Workbooks.Open (myDir & "\" & myFile.Name)
    myCounter = myCounter + 1
    ReDim Preserve myList(1 To myCounter)
    myList(myCounter) = myDir & "\" & myFile.Name

    ''loop to pull out all code rows in your directories into new file
    Workbooks(Workbooks.Count).Worksheets(1).Range("d2").Activate
    Rowcount = Workbooks(1).Sheets(1).Range("a1").CurrentRegion.Rows.Count + 1
    Rows(1).AutoFilter
    Range("A1").AutoFilter Field:=3, Criteria1:=code, Operator:=xlAnd
    Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
    Destination:=Workbooks(1).Sheets(1).Range("a" & Rowcount)

    'filter out the code data
    Workbooks(Workbooks.Count).Worksheets(2).Activate
    Range("d2").Activate
    rowcount2 = Workbooks(1).Sheets(2).Range("a1").CurrentRegion.Rows.Count + 1
    Rows(1).AutoFilter
    Range("A1").AutoFilter Field:=6, Criteria1:=code, Operator:=xlAnd
    Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
      Destination:=Workbooks(1).Sheets(2).Range("a" & Rowcount)

    Workbooks(myFile.Name).Close savechanges:=False
Next

If SearchSubFol Then
    For Each myFolder In fso.GetFolder(myDir).SubFolders
        myFileSearch myDir & "\" & myFolder.Name, FileNameLike, FileTypeLike, True, myCounter
    Next
End If

End Sub

打开每个工作簿需要花费5-10秒的时间，整个过程非常缓慢（而且目前还存在错误）。

2) 将所有内容导入两个Access表中，然后仅保留我想要的代码行。由于行数较多，这种方法比Excel更慢。

Sub pulloop()

DoCmd.RunSQL "delete * from sts"
DoCmd.RunSQL "delete * from cps"

strSql = "PathMap"
Set rs = CurrentDb.OpenRecordset(strSql)

With rs

    If Not .BOF And Not .EOF Then
        .MoveLast
        .MoveFirst

        While (Not .EOF)
            importfile = rs.Fields("Path")

            DoCmd.TransferSpreadsheet acimport, acSpreadsheetTypeExcel12, "Sts", importfile, True, "Sts!A:G"

           DoCmd.TransferSpreadsheet acimport, acSpreadsheetTypeExcel12, "CPs", importfile, True, "CPs!A:Q"
            'Debug.Print rs.Fields("Path")
            .MoveNext
        Wend

    End If

    .Close

End With

End Sub

我尝试使用AcLink进行适应，但在实现过程中遇到了困难。是否可能在Access导入文件时使用aclink而不是acimport来查询所需的代码行，并且这样做可能会更快速？

- user3049991

---

问题更适合于代码审查。 - brettdj

也许这个问题有一些有用的信息：https://dev59.com/JWsz5IYBdhLWcg3wADIm - Jens

与5-10秒的文件打开开销相比，实际数据操作需要多长时间？有一些可以改进的地方（例如删除“激活”等）。也许可以采用新的路线，将xlsx文件保存为csv文件，并使用PowerShell（学习起来不太难）来操作csv文件，这样针对可重复任务会有所改善。 - brettdj

打开文件是第一个耗时的任务，我想通过从关闭的工作簿中获取数据来解决这个问题。另一个耗时的任务是复制粘贴自动筛选器数据。我已经了解到将数据放入数组中，并将接收数据的工作簿的范围设置为该数组，比复制粘贴要快得多。我不介意学习如何使用PowerShell，但是这些文件需要保持原始格式，因为它们存储在共享驱动器上，每天都会有新文件加入，我无法维护它们的单独CSV库。 - user3049991

嗨，我发现将所有100个表格导入Access后，近1000万行数据需要很长时间才能导入。我需要这个是临时的。只选择我想要的特定数据行可以将其减少到几百万，但我发现通过循环提取创建新的超级文件或大型Access导入都需要10分钟或更长时间。如果有更快的建议，将不胜感激！ - user3049991

Answer 1

看起来你第二个选项中的一个问题是，你正在从 Excel 文件中导入所有行。尝试使用 Excel 对象模型在两个工作表上定义命名范围，然后在循环中使用 docmd.transferspreadsheet。你需要修改另一个工作表的列引用。希望能有所帮助。

查找实际使用的行的代码，定义命名范围并导入到 Access：

Dim xlApp As Excel.Application     
Dim xlWkb As Excel.Workbook       
Dim xlWS As Excel.Worksheet 
Dim lngLastRow as Long
Dim myImportRange as Range
dim strRangeName as String
set xlApp = New Excel.Application
xlApp.Visible=False 'make it go faster
set xlWB = xlApp.Workbooks.Open("PATH")
set xlWS = xlWB.Sheets("sts")
lngLastRow=xlWS.Range("A" & xlWS.Rows.Count).End(xlUp).Row
Set myImportRange = xlWS.Range("A1:G" & lnglastrow)
strRangeName="myData_2014MMDD"  'or any name that makes sense to you
myImportRange.Name=strRangeName
xlWB.Save
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, <Dest Table>, xlWb.FullName, True, strRangeName
xlApp.DisplayAlerts=False 'suppress save changes prompts
xlWB.Close False 

- SJL

Answer 2

考虑第三种方法，直接在追加SQL查询中查询工作簿：

With rs
   .MoveLast
   .MoveFirst

   While (Not .EOF)                
      importfile = rs.Fields("Path")
      Debug.Print importfile

      sql = "INSERT INTO sts " _
          & " SELECT * FROM [Excel 12.0 Xml;HDR = Yes;Database=" & importfile & "].[Sts$A:G]"

       CurrentDb.Execute sql, dbFailOnError

      .MoveNext
   Wend        

   .Close    
End With

- Parfait