Question

我在子文件夹中有成千上万个excel文件，我需要从这些文件中提取数据，然后将其全部编译到主表中。这些文件通常会在数月之内一天一天地出现。

我已经建立了一个宏来完成所有这些工作。

我遇到的麻烦是定期重新运行宏以包含新文件。

我需要一种跟踪哪些文件已经被处理，哪些文件没有被处理的方法。到目前为止，我的解决方案是将文件名用作唯一键，并将宏运行的每个文件与保存在第二个工作表上的唯一键列表进行比较。可以想象，这是非常慢的，我想知道是否有更好的解决方案。

下面是我建立的宏：

Option Explicit

    Sub PullInspectionData()
        Dim fso, oFolder, oSubfolder, oFile, queue As Collection
        Dim n, i As Long
        Dim wb, mwb As Workbook
        Dim wsb, mws, cws As Worksheet
        Dim DefectCode, Level, LocationComments As String
        Dim PhaseName As String

        'Optimize Macro Speed
          Application.ScreenUpdating = False
          Application.EnableEvents = False
          Application.Calculation = xlCalculationManual
          Application.AskToUpdateLinks = False
          Application.DisplayAlerts = False

        'Creates the collection of files within the subfolder
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set queue = New Collection
        Set mwb = ActiveWorkbook
        Set mws = mwb.Worksheets("Inspection Data")
        Set cws = mwb.Worksheets("Macro Controls")
        RowNumber = Worksheets("Inspection Data").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count + 1
        queue.Add fso.GetFolder("filepath") 'obviously replace
        DoEvents

        Do While queue.Count > 0
            Set oFolder = queue(1)
            queue.Remove 1 'dequeue
            DoEvents


            '...insert any folder processing code here...


            For Each oSubfolder In oFolder.subfolders
                queue.Add oSubfolder 'enqueue
                DoEvents
            Next oSubfolder
            DoEvents
            For Each oFile In oFolder.Files
            On Error Resume Next
            DoEvents


' Operate on each file
'This keeps track of which files have already been processed
                n = Worksheets("MacroControls").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
                For i = 1 To n
                If Cells(i, 1).Value = oFile.Name Then
                GoTo SkipLoop
                DoEvents
                End If
                Next i
                DoEvents

                'Actually begins to Copy Information to the Master File
                Cells(i, 1).Value = oFile.Name
                Set wb = Workbooks.Open(oFile)
                Set wsb = wb.Worksheets("PO Data")
                DoEvents

'file processing code removed for simplicity    

               DoEvents
               wb.Close SaveChanges:=False
               DoEvents
    SkipLoop:
            Next oFile
            DoEvents
        Loop

    'Reset Macro Optimization Settings
        Application.EnableEvents = True
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
        Application.DisplayAlerts = True
        Application.AskToUpdateLinks = True

    End Sub

“检查数据”工作表是在其中编译所有信息的主文件，“宏控件”工作表包含已进行操作的文件列表。

如何加快速度？

Answer 1

您的过程是如此缓慢，因为您每次都在控制表中循环浏览每个文件名。太疯狂了。

尝试这样的事情：

For Each oFile In oFolder.Files

    If cws.Range("A:A").Find(oFile.Name, lookat:=xlWhole) is Nothing Then

         'process this file

    End If

Next

这种方法的另一个优点是它将消除您的GoTo语句，该语句仅在真正紧急情况下使用。

跟踪已经处理过VBA的Excel文件

1 个答案: