当前位置：文江博客话题详情

用Excel提取数据

发布于 2024-07-29 05:43:15 字数 140 浏览 4 评论 0原文

我每月收到 100 多个 Excel 电子表格，我从中选取固定范围并粘贴到其他电子表格中以制作报告。

我正在尝试编写一个 VBA 脚本来迭代我的 Excel 文件并将范围复制到一个电子表格中，但我无法做到这一点。

是否有捷径可寻？

原文

分享到QQ

分享到微博

如果你对这篇内容有疑问，欢迎到本站社区发帖提问参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

发布评论

需要登录才能够评论，你可以免费注册一个本站的账号。

李白 2024-08-05 05:43:15

下面是一些 VBA 代码，演示了对目录中的一堆 Excel 文件进行迭代并打开每个文件：

Dim sourcePath As String
Dim curFile As String
Dim curWB As Excel.Workbook
Dim destWB As Excel.Workbook

Set destWB = ActiveWorkbook
sourcePath = "C:\files"

curFile = Dir(sourcePath & "\*.xls")
While curFile <> ""
    Set curWB = Workbooks.Open(sourcePath & "\" & curFile)

    curWB.Close
    curFile = Dir()
Wend

希望这对于您使用现有的宏代码来说是一个足够好的起点。

Here's some VBA code that demonstrates iterating over a bunch of Excel files in a directory and opening each one:

Dim sourcePath As String
Dim curFile As String
Dim curWB As Excel.Workbook
Dim destWB As Excel.Workbook

Set destWB = ActiveWorkbook
sourcePath = "C:\files"

curFile = Dir(sourcePath & "\*.xls")
While curFile <> ""
    Set curWB = Workbooks.Open(sourcePath & "\" & curFile)

    curWB.Close
    curFile = Dir()
Wend

Hopefully that'll be a good enough starting point for you to work your existing macro code.

回复收藏 0 原文

坦然微笑 2024-08-05 05:43:15

我几年前写过这篇文章，但也许它会对你有所帮助。我添加了最新版本 Excel (xlsx) 的扩展名。似乎有效。

Sub MergeExcelDocs()
    Dim lastRow As Integer
    Dim docPath As String
    Dim baseCell As Excel.range
    Dim sysObj As Variant, folderObj As Variant, fileObj As Variant
    Application.ScreenUpdating = False
    docPath = Application.GetOpenFilename(FileFilter:="Text Files (*.txt),*.txt,Excel Files (*.xls),*.xls,Excel 2007 Files (*.xlsx),*.xlsx", FilterIndex:=2, Title:="Choose any file")
    Workbooks.Add
    Set baseCell = range("A1")
    Set sysObj = CreateObject("scripting.filesystemobject")
    Set fileObj = sysObj.getFile(docPath)
    Set folderObj = fileObj.ParentFolder
    For Each fileObj In folderObj.Files
        Workbooks.Open Filename:=fileObj.path
        range(range("A1"), ActiveCell.SpecialCells(xlLastCell)).Copy
        lastRow = baseCell.SpecialCells(xlLastCell).row
        baseCell.Offset(lastRow, 0).PasteSpecial (xlPasteValues)
        baseCell.Copy
        ActiveWindow.Close SaveChanges:=False
    Next
End Sub

编辑：

我应该提到它是如何工作的。当您启动宏时，它会弹出一个“打开文件”对话框。双击列表中的第一个文件（或任何与此相关的文件）。它将创建一个新的工作簿，然后循环遍历文件夹中的所有文件。对于每个文件，它会复制第一个工作表中的所有内容并将其粘贴到新工作簿的末尾。这几乎就是全部内容了。

I wrote this years ago, but maybe it will help you out. I added the extension for the latest version of Excel (xlsx). Seems to work.

Sub MergeExcelDocs()
    Dim lastRow As Integer
    Dim docPath As String
    Dim baseCell As Excel.range
    Dim sysObj As Variant, folderObj As Variant, fileObj As Variant
    Application.ScreenUpdating = False
    docPath = Application.GetOpenFilename(FileFilter:="Text Files (*.txt),*.txt,Excel Files (*.xls),*.xls,Excel 2007 Files (*.xlsx),*.xlsx", FilterIndex:=2, Title:="Choose any file")
    Workbooks.Add
    Set baseCell = range("A1")
    Set sysObj = CreateObject("scripting.filesystemobject")
    Set fileObj = sysObj.getFile(docPath)
    Set folderObj = fileObj.ParentFolder
    For Each fileObj In folderObj.Files
        Workbooks.Open Filename:=fileObj.path
        range(range("A1"), ActiveCell.SpecialCells(xlLastCell)).Copy
        lastRow = baseCell.SpecialCells(xlLastCell).row
        baseCell.Offset(lastRow, 0).PasteSpecial (xlPasteValues)
        baseCell.Copy
        ActiveWindow.Close SaveChanges:=False
    Next
End Sub

EDIT:

I should mention how it works. When you start the macro, it brings up an Open File dialog. Double-click the first file in the list (or any file for that matter). It will create a new workbook then loop through all the files in the folder. For each file, it copies all the content from the first worksheet and pastes it at the end of the new workbook. That's pretty much all there is to it.

回复收藏 0 原文

紅太極 2024-08-05 05:43:15

另一个解决方案是让您的汇总电子表格通过文件名访问其他电子表格并获取数据本身。

为此，您需要同时打开所有电子表格，以便它可以更新链接，但这仍然可能比一次打开并复制/粘贴一个电子表格更快，即使使用宏也是如此。每个电子表格都需要有一个唯一的文件名。

如果电子表格的名称在您收到之前不知道，或者它们定期更改，请在汇总表中创建一列来存储工作表的文件名，然后使用字符串操作构建所需的地址并获取数据使用间接()。

从一个特定文件中获取一个数据单元格的示例：

=INDIRECT("'[C:\path\workbook.xls]MyWorksheet'!$A$2")

对您想要获取的每个电子表格的每个单元格进行冲洗并重复上述操作。

您应该清楚如何将字符串传递给 INDIRECT()。将其构建为公式，以便您可以对需要检索的每个单元格使用相同的公式。

示例：

= INDIRECT("'[" & $A2 & "]MyWorksheet'!$" & ADDRESS(3, COL()))

上面的公式将转到文件名为 $A2 的电子表格（请注意“2”之前缺少 $，以便您可以将相同的公式粘贴到其他文件的其他行），并获取MyWorksheet 工作表位于第三行和当前列（因此，如果该工作表位于汇总的 B2 中，则它会从其他文件获取 B3）。

调整 ADDRESS 函数以添加所需行和列的偏移量。

上述解决方案的优点是，可以在需要填充的行和列中复制并粘贴相同的公式，Excel 将根据需要调整 $A2 和 COL()。非常易于维护。

编辑曾经遇到过类似的情况，但我无法一次加载所有电子表格（超过 200 个）。我认为我最终编写了 VBA，因此它没有实际打开并读取 Excel 文件。相反，我让它循环遍历文件名，打开每个文件名的 ODBC 连接，并使用 ADO 从规定的命名范围中读取我需要的值（在 ODBC 中显示为“表”，工作表也显示为“表”） “但有关于允许的名称的规则）。这比打开和关闭 Excel 文件要快得多，并且具有不会使 Excel 崩溃的额外优点。

Another solution is to have your roll-up spreadsheet access the other spreadsheets by filename and grab the data itself.

To do that, you'll need to have all of the spreadsheets open at the same time so it can update the links, but that's still probably faster than opening and copying/pasting one at a time, even with a macro. Every spreadsheet will need to have a unique filename.

If the names of the spreadsheets aren't known until you receive them, or they change regularly, create a column in your roll-up table to store the filename of the sheets, then build the address you need using string manipulation and get the data using INDIRECT().

Example to grab one cell of data from one particular file:

=INDIRECT("'[C:\path\workbook.xls]MyWorksheet'!$A$2")

Rinse and repeat the above for each cell of each spreadsheet you want to get.

You should be clever about how to get the string to pass to INDIRECT(). Build it as a formula so you can use literally the same formula for every cell you need to retrieve.

Example:

= INDIRECT("'[" & $A2 & "]MyWorksheet'!$" & ADDRESS(3, COL()))

The formula above will go to the spreadsheet whose filename is in $A2 (note the lack of $ before "2" so you can paste the same formula to other rows for other files), and get the value of the cell on the MyWorksheet sheet on row three and the current column (so, if this is in B2 on your roll-up, it gets B3 from the other file).

Adjust the ADDRESS function to add offsets to the row and column needed.

The advantage of the solution above is that the same formula can be copied and pasted across the rows and columns you need to populate, and Excel will adjust the $A2 and COL() as needed. Very maintainable.

Edit once I had a similar situation, and I couldn't load all of the spreadsheets at once (more than 200). I think I ended up writing the VBA so it did not actually open and read the Excel files. Instead, I had it loop through the filenames, open an ODBC connection to each, and use ADO to read the values I needed from a prescribed named range (which appears as a "table" in ODBC--the worksheets also appear as "tables" but there are rules about allowed names). This was much faster than opening and closing Excel files, and had the added advantage of not crashing Excel.

回复收藏 0 原文