VBA - 循环多个工作簿并保存到主工作簿时覆盖的单元格

Question

我有一个包含多个 .xlsx 工作簿的文件夹，所有这些工作簿在一页上都包含相同的 3 个表格，布局完全相同，但每个表格中的值不同。由于每个工作簿在同一页面上包含 3 个表，因此我有一个 VBA 脚本，它遍历文件夹中的文件，并专门从 3 个表中的每个表中提取必要的数据/单元格并将其写入活动或“主”工作簿。我遇到的问题是，虽然它正在正确写入数据并且以我需要的格式写入数据，即第 1 行上的表 1 数据、第 2 行上的表 2 数据、第 3 行上的表 3 数据等.. 对于每个工作簿-它读取的每个新工作簿都会覆盖以前的工作簿数据。所以最后我只剩下脚本读取的最后一个表中的数据。到目前为止，这是我的代码：

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

到目前为止，我已经完成了提取正确的文件，从第一个工作簿的第一个表中读取数据并将其放置在主工作簿的第一行，然后是第一个工作簿的第二个表并将其放置第二行中的数据，然后是第三行中的数据，以此类推。之后，它关闭第一个工作簿并打开第二个工作簿，并通过目录中的 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)

但这不允许我指定一个表何时结束以切到下一个表的新行。

我是 VBA 新手，但希望能提供任何帮助！

谢谢

Answer 1

您已经找到了 90% 的解决方案。第 1、2、3 行不断被覆盖，因为您的原始代码使用了这些静态行引用。要解决它，您需要改用一个变量（在您的示例中称为 y）。

唯一缺少的部分是当您需要向下移动一行时控制行引用。您可以简单地将y + 1 用于第二个表，将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