vba 使用 Excel 提取数据
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/1180430/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Data extraction with Excel
提问by Rodrigo
I monthly receive 100+ excel spreadsheet from wich i take a fixed range and paste in other spreadsheet to make a report.
我每月收到 100 多个 excel 电子表格，我采用固定范围并粘贴到其他电子表格中以制作报告。
Im trying to write a vba script to iterate my excel files and copy the range in one spreadsheet, but i havent been able to do it.
我正在尝试编写一个 vba 脚本来迭代我的 excel 文件并将范围复制到一个电子表格中，但我无法做到。
Is there an easy way to do this?
是否有捷径可寻？
采纳答案by devuxer
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.
这是我几年前写的，但也许它会帮助你。我为最新版本的 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
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.
我应该提到它是如何工作的。当您启动宏时，它会弹出一个打开文件对话框。双击列表中的第一个文件（或任何与此相关的文件）。它将创建一个新工作簿，然后遍历文件夹中的所有文件。对于每个文件，它复制第一个工作表中的所有内容并将其粘贴到新工作簿的末尾。这就是它的全部内容。
回答by Mark Biek
Here's some VBA code that demonstrates iterating over a bunch of Excel files in a directory and opening each one:
下面是一些 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
Hopefully that'll be a good enough starting point for you to work your existing macro code.
希望这将是一个足够好的起点，让您可以使用现有的宏代码。
回答by richardtallent
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")
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 sameformula for every cell you need to retrieve.
您应该很聪明地了解如何将字符串传递给 INDIRECT()。将其构建为公式，以便您可以对需要检索的每个单元格使用完全相同的公式。
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 currentcolumn (so, if this is in B2 on your roll-up, it gets B3 from the other file).
上面的公式将转到文件名在 $A2 中的电子表格（注意“2”之前缺少 $，因此您可以将相同的公式粘贴到其他文件的其他行），并获取 MyWorksheet 工作表上单元格的值在第三行和当前列（因此，如果它在汇总的 B2 中，它将从另一个文件中获取 B3）。
Adjust the ADDRESS function to add offsets to the row and column needed.
调整 ADDRESS 函数以向所需的行和列添加偏移量。
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.
上述解决方案的优点是可以在需要填充的行和列之间复制和粘贴相同的公式，Excel 将根据需要调整 $A2 和 COL()。非常可维护。
Editonce 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 notactually 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.
遇到类似情况后编辑，我无法一次加载所有电子表格（超过 200 个）。我想我最终编写了 VBA，所以它实际上并没有打开和读取 Excel 文件。相反，我让它循环遍历文件名，打开到每个文件名的 ODBC 连接，然后使用 ADO 从指定的命名范围（在 ODBC 中显示为“表”——工作表也显示为“表”）中读取我需要的值" 但有关于允许名称的规则）。这比打开和关闭 Excel 文件要快得多，并且具有不会使 Excel 崩溃的额外优势。
回答by Mark Nold
Rodrigo,
罗德里戈，
I'm guessing you mean 100+ workbooks that you need to individually open and copy and paste into one? Sounds like fun :)
我猜您的意思是 100 多个工作簿需要单独打开并复制并粘贴到一个中？听起来很好玩 ：）
If you could put them all in a single directory, opening each file is reasonably easy, have a search on that first. (@Mark Biek has posted a good example for you )
如果您可以将它们全部放在一个目录中，则打开每个文件相当容易，请先进行搜索。（@Mark Biek 为你发布了一个很好的例子）
Once you have a file open, i would then copy the data into an ADO recordset which you would then append to. I have posted some codefor a doing something very similar with merging multiple sheets in one workbook.
打开文件后，我会将数据复制到 ADO 记录集中，然后您将附加到该记录集中。我已经发布了一些代码，用于在一个工作簿中合并多个工作表来做一些非常相似的事情。
It's not exactly what you need, but it should help. If not, post how far you get and i'll have a another look during the week.
这不完全是您所需要的，但应该会有所帮助。如果没有，请发布您到达多远，我将在本周再看一次。
回答by THEn
Did you try
你试过了吗
Tools->Macro->Record New Macro
to create maco to do the same thing
创建 maco 来做同样的事情
回答by THEn
This can be achieved by using TransferSpreadsheet in Access. See this link:
这可以通过在 Access 中使用 TransferSpreadsheet 来实现。请参阅此链接：
This solution doesn't require any VBA.
此解决方案不需要任何 VBA。
回答by imfrancisd
In the past, I used VBA to create external references (links).
过去，我使用 VBA 创建外部引用（链接）。
I posted about it here (see example 2):
我在这里发布了它（参见示例 2）：
Best short examples of the need for Excel VBA
It's similar to using INDIRECT, but without needing to have the excel workbooks open.
它类似于使用 INDIRECT，但无需打开 excel 工作簿。
The only disadvantage is that an old computer or an old version of excel, not sure which, can make this process slow. I believe it is because every time a new external reference is added, all the other external references gets updated. In order to make it go faster, I set Calculation to Manual, added the external references, and set Calculation to Automatic to update them.
唯一的缺点是旧计算机或旧版本的 excel，不确定是哪个，会使此过程变慢。我相信这是因为每次添加新的外部引用时，所有其他外部引用都会更新。为了使它运行得更快，我将计算设置为手动，添加了外部参考，并将计算设置为自动以更新它们。
After that, if you just want the values, you can use Break Links, or Copy and Paste Special Values.
之后，如果您只需要这些值，您可以使用断开链接或复制和粘贴特殊值。
