Question

我有数以千计的excel文件格式完全相同，并且都位于我们服务器上的同一文件夹中。

我尝试做的是从每个excel文件中提取特定数据，并将它们编译到位于我们服务器上不同位置的单个excel文件中。优选地，在可以分类，过滤等的Excel表中

有人知道实现这一目标的最简单方法是什么？

拥有这个＆＃34;单个Excel文件＆＃34;也是理想的选择。解决方案包括“自动更新”的能力。任何时候将新文件添加到其他数千个文件中。

用更一般的术语来说明......

我正在尝试制作家庭酿造采购订单系统。多年来，我们已经创建了数千个单独的采购订单，目前正在进行＆＃34; Save-As＆＃34;在最近的一个创建下一个。

我们现在需要的是能够将这些单独的PO文件中的特定数据片段合并到一个新的（希望自动更新）PO日志文件中。

如果这没有意义，我道歉。我感谢任何人可能拥有的任何和所有帮助/想法。

更新：下面你会发现我目前正在做的事情，试图实现我要求更简单的解决方案。

我已经建立了一个工作簿，用于收集/提取数据，数百个（以及不断增长的）不同的已关闭工作簿。它基本上是一个采购订单日志，可以在创建时自动收集各个采购订单的数据。

此PO日志工作簿是一个包含8列的表，A：H。

A栏中有以下公式。

=SUBSTITUTE(IF(ISERROR(INDEX(FL,ROW()-2)),"",INDEX(FL,ROW()-2)),".xlsx","")

其中＆＃34; FL＆＃34;是我们各个采购订单文件的文件夹位置的名称替换。如公式所示，它会搜索该文件夹中该文件夹中任何现有文件或新文件的文件夹位置，然后将该文件名（减去扩展名（.xlsx））传输到A列中的相应行。

这是A列中检索到的数据，它驱动剩余列中的其余公式（B：H）。那些剩余的公式看起来完全相同，除了它们从中请求数据的特定单元格。列B：H中包含以下公式。

=IFERROR(INDIRECT.EXT("'\\MyPath\["&$A3&".xlsx"&"]Purchase Order'!F9"),"")

您会注意到此公式正在查找名为A列中各个单元格+ .xlsx的文件。找到该文件后，它将在Cell F9中查找数据。每个剩余的列都在寻找不同单元格中的数据，但公式的其余部分保持不变。

那应该是一本非常简单的工作手册的肉和土豆。

虽然超时发生的事情是我们现在有超过一千个单独的文件，这个工作簿正在研究，并且它导致计算时间呈指数级增长。现在，我们必须等待30多分钟才能更新PO日志文件。随着越来越多的个人PO文件的创建，这段时间越来越多。

Answer 1

好的 - 见下文。这对我来说有一个小的测试文件集。希望您可以看到您需要更新它以进行设置。

将此代码粘贴到常规VBA模块中，并添加对Microsoft Scripting Runtime的引用（在VB编辑器＆gt;＆gt;工具＆gt;＆gt;引用中）

编辑：调整为使用没有扩展名的文件名。但请注意：如果您有两个名称相同的文件但是一个是* .xls而另一个是* .xlsx

，这可能会导致问题

Sub RefreshMasterList()

    Const SRC_FOLDER As String = "C:\_Stuff\test\"
    Const COL_FNAME As Long = 1
    Const COL_LAST_MOD As Long = 2

    Dim fso As New Scripting.FileSystemObject
    Dim fold As Scripting.Folder, fl As Scripting.File
    Dim f As Range, sht As Worksheet, rw As Range, dtlm
    Dim getInfo As Boolean, wb As Workbook, ws As Worksheet
    Dim baseName As String

    Set sht = ThisWorkbook.Sheets("Master")

    'clear all file status flag colors
    sht.Columns(COL_FNAME).Interior.ColorIndex = xlNone

    Set fold = fso.GetFolder(SRC_FOLDER)
    For Each fl In fold.Files
        If fl.Name Like "*.xls*" Then
            getInfo = False
            dtlm = Format(fl.DateLastModified, "yyyy-mm-dd-hh:mm:ss")
            baseName = fso.GetBaseName(fl.Name)

            'have this file already ?
            Set f = sht.Columns(1).Find(baseName, lookat:=xlWhole, _
                                         LookIn:=xlValues)
            If f Is Nothing Then 'not already listed...
                Set rw = sht.Cells(Rows.Count, COL_FNAME).End(xlUp) _
                                    .Offset(1, 0).EntireRow
                With rw
                    .Cells(COL_FNAME).Value = baseName
                    'flag new
                    .Cells(COL_FNAME).Interior.Color = vbGreen
                    .Cells(COL_LAST_MOD).Value = dtlm
                End With
                getInfo = True
            Else
                Set rw = f.EntireRow
                If rw.Cells(COL_LAST_MOD).Value < dtlm Then
                    Debug.Print f.Cells(COL_LAST_MOD).Value, dtlm
                    'flag updated
                    rw.Cells(COL_FNAME).Interior.Color = vbYellow
                    rw.Cells(COL_LAST_MOD).Value = dtlm
                    getInfo = True
                Else
                    'flag no change
                    rw.Cells(COL_FNAME).Interior.Color = RGB(220, 220, 220)
                End If
            End If

            If getInfo Then 'need to add/update from this file?
                Set wb = Workbooks.Open(fl.Path, , True)
                With wb.Sheets("Purchase Order")
                    rw.Cells(3).Value = .Range("F9").Value
                    rw.Cells(4).Value = .Range("F10").Value
                    'etc...
                End With
                wb.Close False 'don't save...
            End If

        End If
    Next fl
End Sub

将数千个Excel文件中的数据编译成一个工作簿的最佳方法？

1 个答案: