VBA - 遍历多个工作簿并保存到主工作簿时单元格被覆盖
VBA - cells overwritten when looping through multiple workbooks and saving to master workbook
我有一个包含多个 .xlsx 工作簿的文件夹，所有这些工作簿在一页上都包含相同的 3 个 table，布局完全相同，但每个 table 中的值不同。由于每个工作簿在同一页上包含 3 table，我有一个 VBA 脚本循环遍历文件夹中的文件，并专门从 3 [=34] 中的每一个中提取必要的 data/cells =]s 并将其写入活动或 'master' 工作簿。我遇到的问题是，尽管它正确地写入了数据并且采用了我需要的格式，即第 1 行的 Table 1 个数据，第 2 行的 Table 2 个数据，Table 3第 3 行等的数据。对于每个工作簿 - 它读取的每个新工作簿都会覆盖以前的工作簿数据。所以最后我只剩下脚本读取的最后一个 table 的数据。到目前为止，这是我的代码：
Sub getDataFromWbs()
Dim wb As Workbook, ws As Worksheet
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder("path-to-directory-with-multiple-workbooks")
For Each wbFile In fldr.Files
If fso.GetExtensionName(wbFile.Name) = "xlsx" Then
Set wb = Workbooks.Open(wbFile.Path)
For Each ws In wb.Sheets
'Some table data to be laid out from A1 to C1 in the master workbook
ThisWorkbook.Sheets("Sheet1").Cells(1, 1) = ws.Cells(4, 1)
ThisWorkbook.Sheets("Sheet1").Cells(1, 2) = ws.Cells(5, 29)
ThisWorkbook.Sheets("Sheet1").Cells(1, 3) = ws.Cells(5, 32)
'Table Data to be Laid out From D1 to F1 in the master workbook
ThisWorkbook.Sheets("Sheet1").Cells(1, 4) = ws.Cells(18, 1)
ThisWorkbook.Sheets("Sheet1").Cells(1, 5) = ws.Cells(18, 2)
ThisWorkbook.Sheets("Sheet1").Cells(1, 6) = ws.Cells(18, 4)
'Some table data to be laid out from A2 to C2 in the master workbook
ThisWorkbook.Sheets("Sheet1").Cells(2, 1) = ws.Cells(8, 15)
ThisWorkbook.Sheets("Sheet1").Cells(2, 2) = ws.Cells(8, 22)
ThisWorkbook.Sheets("Sheet1").Cells(2, 3) = ws.Cells(9, 15)
'Table Data to be Laid out From D2 to F2 in the master workbook
ThisWorkbook.Sheets("Sheet1").Cells(2, 4) = ws.Cells(18, 20)
ThisWorkbook.Sheets("Sheet1").Cells(2, 5) = ws.Cells(18, 23)
ThisWorkbook.Sheets("Sheet1").Cells(2, 6) = ws.Cells(18, 25)
'Some table data to be laid out from A3 to C3 in the master workbook
ThisWorkbook.Sheets("Sheet1").Cells(3, 1) = ws.Cells(19, 29)
ThisWorkbook.Sheets("Sheet1").Cells(3, 2) = ws.Cells(19, 30)
ThisWorkbook.Sheets("Sheet1").Cells(3, 3) = ws.Cells(19, 32)
'Table Data to be Laid out From D3 to F3 in the master workbook
ThisWorkbook.Sheets("Sheet1").Cells(3, 4) = ws.Cells(19, 38)
ThisWorkbook.Sheets("Sheet1").Cells(3, 5) = ws.Cells(19, 40)
ThisWorkbook.Sheets("Sheet1").Cells(3, 6) = ws.Cells(19, 43)
Next ws
wb.Close
End If
Next wbFile
End Sub
到目前为止，我已经完成提取正确的文件，从第一个工作簿中的第一个 table 读取数据并将其放在主工作簿的第一行，然后是第二个 [=第一个工作簿的 34=] 并将该数据放在第二行，然后是第三行等。之后它关闭第一个工作簿并打开第二个工作簿并与下一个空行进行相同的过程，依此类推通过 x 数量目录中的工作簿数。
我想我的问题是我明确说明
ThisWorkbook.Sheets("Sheet1").Cells(1, 1) = ws.Cells(4, 1)
...
将它拉取的数据写入 Cell(x, x)，我目前正在明确指定将它放在哪里。这就是为什么对于它迭代的每个工作簿，它只会覆盖当前存在的单元格数据。我尝试将 'y' 设置为：
y = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
然后将其用作：
ThisWorkbook.Sheets("Sheet1").Cells(y, 1) = ws.Cells(4, 1)
但这不允许我指定一个 table 何时结束以剪切到下一个 table 的新行。
我是 VBA 的新手，但非常感谢任何帮助！
谢谢
您已自行找到 90% 的解决方案。第 1、2、3 行不断被覆盖，因为您的原始代码使用了这些静态行引用。要解决它，您需要改用变量（在您的示例中称为 y）。
唯一缺少的部分是在需要向下移动一行时控制行引用。您可以简单地对第二个 table 使用 y + 1，对第三个 table 使用 y + 2：
ThisWorkbook.Sheets("Sheet1").Cells(y + 1, 1).Value = ws.Cells(4, 1).Value
[针对 Gideon B 的评论展开回答：]
您需要通过代码循环来管理变量行引用。为了清楚起见，我将变量称为 WriteRow。我们还可以在单独的代码行中增加 WriteRow 的值，以提高可读性。在模式中，您将希望按照以下方式做一些事情：
'Initialize your variable at the outset
WriteRow = 1
For Each wbFile In fldr.Files
If fso.GetExtensionName(wbFile.Name) = "xlsx" Then
Set wb = Workbooks.Open(wbFile.Path)
For Each ws In wb.Sheets
ThisWorkbook.Sheets("Sheet1").Cells(WriteRow, 1) = SomeTable1Data
'... write as much data as you need to this row ...
'... then increment WriteRow:
WriteRow = WriteRow + 1
ThisWorkbook.Sheets("Sheet1").Cells(WriteRow, 1) = SomeTable2Data
'... etc., incrementing WriteRow as needed
'Make sure to end by incrementing WriteRow in preparation for the next loop
WriteRow = WriteRow + 1
Next ws
wb.Close
End If
Next wbFile
我有一个包含多个 .xlsx 工作簿的文件夹，所有这些工作簿在一页上都包含相同的 3 个 table，布局完全相同，但每个 table 中的值不同。由于每个工作簿在同一页上包含 3 table，我有一个 VBA 脚本循环遍历文件夹中的文件，并专门从 3 [=34] 中的每一个中提取必要的 data/cells =]s 并将其写入活动或 'master' 工作簿。我遇到的问题是，尽管它正确地写入了数据并且采用了我需要的格式，即第 1 行的 Table 1 个数据，第 2 行的 Table 2 个数据，Table 3第 3 行等的数据。对于每个工作簿 - 它读取的每个新工作簿都会覆盖以前的工作簿数据。所以最后我只剩下脚本读取的最后一个 table 的数据。到目前为止，这是我的代码：
Sub getDataFromWbs()
Dim wb As Workbook, ws As Worksheet
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder("path-to-directory-with-multiple-workbooks")
For Each wbFile In fldr.Files
If fso.GetExtensionName(wbFile.Name) = "xlsx" Then
Set wb = Workbooks.Open(wbFile.Path)
For Each ws In wb.Sheets
'Some table data to be laid out from A1 to C1 in the master workbook
ThisWorkbook.Sheets("Sheet1").Cells(1, 1) = ws.Cells(4, 1)
ThisWorkbook.Sheets("Sheet1").Cells(1, 2) = ws.Cells(5, 29)
ThisWorkbook.Sheets("Sheet1").Cells(1, 3) = ws.Cells(5, 32)
'Table Data to be Laid out From D1 to F1 in the master workbook
ThisWorkbook.Sheets("Sheet1").Cells(1, 4) = ws.Cells(18, 1)
ThisWorkbook.Sheets("Sheet1").Cells(1, 5) = ws.Cells(18, 2)
ThisWorkbook.Sheets("Sheet1").Cells(1, 6) = ws.Cells(18, 4)
'Some table data to be laid out from A2 to C2 in the master workbook
ThisWorkbook.Sheets("Sheet1").Cells(2, 1) = ws.Cells(8, 15)
ThisWorkbook.Sheets("Sheet1").Cells(2, 2) = ws.Cells(8, 22)
ThisWorkbook.Sheets("Sheet1").Cells(2, 3) = ws.Cells(9, 15)
'Table Data to be Laid out From D2 to F2 in the master workbook
ThisWorkbook.Sheets("Sheet1").Cells(2, 4) = ws.Cells(18, 20)
ThisWorkbook.Sheets("Sheet1").Cells(2, 5) = ws.Cells(18, 23)
ThisWorkbook.Sheets("Sheet1").Cells(2, 6) = ws.Cells(18, 25)
'Some table data to be laid out from A3 to C3 in the master workbook
ThisWorkbook.Sheets("Sheet1").Cells(3, 1) = ws.Cells(19, 29)
ThisWorkbook.Sheets("Sheet1").Cells(3, 2) = ws.Cells(19, 30)
ThisWorkbook.Sheets("Sheet1").Cells(3, 3) = ws.Cells(19, 32)
'Table Data to be Laid out From D3 to F3 in the master workbook
ThisWorkbook.Sheets("Sheet1").Cells(3, 4) = ws.Cells(19, 38)
ThisWorkbook.Sheets("Sheet1").Cells(3, 5) = ws.Cells(19, 40)
ThisWorkbook.Sheets("Sheet1").Cells(3, 6) = ws.Cells(19, 43)
Next ws
wb.Close
End If
Next wbFile
End Sub
到目前为止，我已经完成提取正确的文件，从第一个工作簿中的第一个 table 读取数据并将其放在主工作簿的第一行，然后是第二个 [=第一个工作簿的 34=] 并将该数据放在第二行，然后是第三行等。之后它关闭第一个工作簿并打开第二个工作簿并与下一个空行进行相同的过程，依此类推通过 x 数量目录中的工作簿数。
我想我的问题是我明确说明
ThisWorkbook.Sheets("Sheet1").Cells(1, 1) = ws.Cells(4, 1)
...
将它拉取的数据写入 Cell(x, x)，我目前正在明确指定将它放在哪里。这就是为什么对于它迭代的每个工作簿，它只会覆盖当前存在的单元格数据。我尝试将 'y' 设置为：
y = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
然后将其用作：
ThisWorkbook.Sheets("Sheet1").Cells(y, 1) = ws.Cells(4, 1)
但这不允许我指定一个 table 何时结束以剪切到下一个 table 的新行。
我是 VBA 的新手，但非常感谢任何帮助！
谢谢
您已自行找到 90% 的解决方案。第 1、2、3 行不断被覆盖，因为您的原始代码使用了这些静态行引用。要解决它，您需要改用变量（在您的示例中称为 y）。
唯一缺少的部分是在需要向下移动一行时控制行引用。您可以简单地对第二个 table 使用 y + 1，对第三个 table 使用 y + 2：
ThisWorkbook.Sheets("Sheet1").Cells(y + 1, 1).Value = ws.Cells(4, 1).Value
[针对 Gideon B 的评论展开回答：]
您需要通过代码循环来管理变量行引用。为了清楚起见，我将变量称为 WriteRow。我们还可以在单独的代码行中增加 WriteRow 的值，以提高可读性。在模式中，您将希望按照以下方式做一些事情：
'Initialize your variable at the outset
WriteRow = 1
For Each wbFile In fldr.Files
If fso.GetExtensionName(wbFile.Name) = "xlsx" Then
Set wb = Workbooks.Open(wbFile.Path)
For Each ws In wb.Sheets
ThisWorkbook.Sheets("Sheet1").Cells(WriteRow, 1) = SomeTable1Data
'... write as much data as you need to this row ...
'... then increment WriteRow:
WriteRow = WriteRow + 1
ThisWorkbook.Sheets("Sheet1").Cells(WriteRow, 1) = SomeTable2Data
'... etc., incrementing WriteRow as needed
'Make sure to end by incrementing WriteRow in preparation for the next loop
WriteRow = WriteRow + 1
Next ws
wb.Close
End If
Next wbFile