时间戳

首页 > 解决方案 > 从多个 Excel 工作簿的不同部分收集数据并将其附加到新工作簿中

excel - 从多个 Excel 工作簿的不同部分收集数据并将其附加到新工作簿中

问题描述

我必须从多个 excel 工作簿（统一格式）的不同部分收集数据并将其附加到新工作簿中。格式类似于下图。我必须从多个工作簿的绿色和蓝色部分（不是表格）收集数据，并将其附加到下一张图片中的表格。 在此处输入图像描述

在此处输入图像描述

我知道这可以使用 VBA 来完成。不幸的是，我以前从未使用过 VBA。如果有人可以提供通用代码或至少为我指明正确的方向，那就太好了。另外，如果这可以通过任何其他方式完成，请分享。谢谢 注意：我有一个所有工作簿的超链接列表。

标签： excelvbaexcel-formula

解决方案

这是您项目的 VBA 速成课程。所有代码都应该可以工作，但我现在正在编写它，所以它未经测试。我将尽力在此示例代码中逐行解释。您可以按单元格、行、列或范围引用所需的所有数据。我建议将所有数据分配给一个数组，然后将数组写入您想要的位置。我想如果这是你需要重复做的事情，我会保存一个包含这段代码的工作簿，并像模板一样使用它。

这是一些代码，可让您从另一个工作簿加载工作表

Dim SourceWorkbook As Workbook, CurrentWorkbook As Workbook 'sets up references to contain workbook information
Set CurrentWorkbook = ThisWorkbook 'ThisWorkBook is a built in excel reference to the book the code is running on
Set SourceWorkbook = Workbooks.Open("D:\file location\inputfile.xlsx") 'assigns the SourceWorkbook reference to the file location inside the quotes

SourceWorkbook.Sheets("Sheet1").Copy After:=CurrentWorkbook.Sheets("Main") 'this code takes the open file assigned to SourceWorkbook and copies "Sheet1" into the Workbook referenced by CurrentWorkbook (thisworkbook) after the sheet titled "Main" 
SourceWorkbook.Close 'closes the workbook you just imported data from

我建议首先将所有数据导入单个工作簿。然后，如果您需要引用某些内容，则需要设置一个数组以使用循环函数或直接引用范围来收集数据。这是一个单循环参考示例。

Dim RowCount as integer
Dim DataSortArray(1 To 1000, 1 To 3) As Variant
RowCount = 1
Do while currentworkbook.sheets("sheet1").Cells(Rowcount, 1) <> "" 
DataSortArray(RowCount, 1) = currentworkbook.sheets("sheet1")Cells(RowCount, 1) 
DataSortArray(RowCount, 2) = currentworkbook.sheets("sheet1")Cells(RowCount, 2) 
DataSortArray(RowCount, 3) = currentworkbook.sheets("sheet1")Cells(RowCount, 3) 
RowCount = RowCount + 1
loop

它逐步为 RowCount 和 DataSortArray 设置变量。第一条记录的 RowCount 设置为 1，每次循环递增 1 以选择下一条记录。每个单元格位置都设置为等于 DataSortArray 中用于存储所有信息的相同位置。如果您有很多列要收集，我建议您在另一个循环中嵌套一个循环来收集数据。这是一个例子。

Dim RowCount as integer, ColCount as integer
Dim DataSortArray(1 To 1000, 1 To 3) As Variant
RowCount = 1
ColCount = 1
Do while currentworkbook.sheets("sheet1").Cells(RowCount, 1) <> ""

Do while ColCount < 4 
DataSortArray(RowCount, ColCount) = currentworkbook.sheets("sheet1")Cells(RowCount, ColCount) 

ColCount = ColCount + 1
loop
RowCount = RowCount + 1
ColCount = 1
loop

这与上面的代码本质上是相同的，但只需更改与之比较的数字，就可以轻松地将列添加到数组中。它将一直收集到列数不少于 4（因此每条记录 3 列） 注意：如果您计划在我的示例中获得多于 3 的列，则需要增加数组大小。IE "Dim DataSortArray(1 To 1000, 1 To 10) As Variant" 这将允许 1000 条记录，每条记录 10 列。

一旦数组填充了您想要的所有数据，您就可以将其写入某个位置

Sheets.Add(After:=Sheets("Sheet1")).name = "Output" 'creates a new sheet called "Output" if you need to add a sheet
Sheets("Output").Range("a1:d10000").Value = DataSortArray 'prints out the finished array to the sheet titled "Output" again if you need more then 4 columns you will need to change the reference to be "Range("a1:j10000").Value" your range can be larger than needed but not smaller.

如果您需要创建一个新文件，这里有一些代码可以做到这一点。

Dim Fname as string

Fname = "C:\new.xlsx"
ActiveWorkbook.SaveAs Filename:= Fname

推荐阅读