Excel VBA：如何使用给定的代码循环在同一文件夹中的工作簿？

（ 上一篇 ）

我需要创build一个macros来循环遍历单个文件夹中的文件，并运行我在下面提供的代码。 所有的文件结构都是一样的，但是有不同的数据。 该代码可以帮助我转到指定的目标文件并计算列中“是”的数目。 然后将其输出到CountResults.xlsm（主工作簿）。 我有以下的代码在Zac的帮助下：

Private Sub CommandButton1_Click() Dim oWBWithColumn As Workbook: Set oWBWithColumn = Application.Workbooks.Open("C:\Users\khanr1\Desktop\CodeUpdateTest\Test01.xlsx") Dim oWS As Worksheet: Set oWS = oWBWithColumn.Worksheets("Sheet2") ThisWorkbook.Worksheets("Sheet1").Range("B2").Value = Application.WorksheetFunction.CountIf(oWS.Range("B:B"), "YES") oWBWithColumn.Close False Set oWS = Nothing Set oWBWithColumn = Nothing End Sub 

这就是CountResults.xlsm（Master Workbook）的样子：

而且，这是Test01.xlsx的一个例子：

要注意的是，有10个testing文件（Test01，Test02 …），但代码应该能够更新任何新增的testing文件（例如Test11，Test12 …）。 我有一个想法，把第一个图像中的“文件”列，以拉文件名并循环它们。

Answer 1

最简单的事情就是将你的代码转换成一个函数。

 Private Sub CommandButton1_Click() Dim r As Range With Worksheets("Sheet1") For Each r In .Range("A2", .Range("A" & .Rows.Count).End(xlUp)) r.Offset(0, 1).Value = getYesCount(r.Value) Next End With End Sub Function getYesCount(WorkBookName As String) As Long Const FolderPath As String = "C:\Users\khanr1\Desktop\CodeUpdateTest\" If Len(Dir(FolderPath & WorkBookName)) Then With Workbooks.Open(FolderPath & WorkBookName) With .Worksheets("Sheet2") getYesCount = Application.CountIf(.Range("B:B"), "YES") End With .Close False End With Else Debug.Print FolderPath & WorkBookName; ": Not Found" End If End Function 

Answer 2

最简单的方法是使用filesystemobject遍历文件夹中的所有文件，find文件名与预定义掩码类似的文件（在你的例子中是“Test * .xslx”）。 请注意，它也通过指定文件夹中的子文件夹。 如果不需要，则省略每个循环的第一个：

 Dim fso As Object 'FileSystemObject Dim fldStart As Object 'Folder Dim fld As Object 'Folder Dim fl As Object 'File Dim oWBWithColumn As Workbook Dim oWbMaster as workbook Dim oWsSource as worksheet Dim oWsTarget as worksheet Dim Mask As String Dim k as long k=2 Set oWbMaster = ActiveWorkbook Set oWsTarget = oWbMaster.Sheets("Sheet1") Set fso = CreateObject("scripting.FileSystemObject") Set fldStart = fso.GetFolder("C:\Users\khanr1\Desktop\CodeUpdateTest\") Mask = "Test*" & ".xlsx" For Each fld In fldStart.Subfolders For Each fl In fld.Files If fl.Name Like Mask Then Set oWBWithColumn = Application.Workbooks.Open(Filename:=fld.Path & "\" & fl.Name, ReadOnly:=True) Set oWsSource = oWBWithColumn.Worksheets("Sheet2") oWsTarget.Range("B"& k).Value = Application.WorksheetFunction.CountIf(oWsSource.Range("B:B"), "YES") oWBWithColumn.Close SaveChanges:=False k = k+1 End If Next Next 

如果这个答案有帮助，请标记为已接受。 另外请注意，您的原始代码将在循环的每次迭代中replace主电子表格中的B2单元格的值，这就是为什么在每次迭代之后添加了kvariables以更改目标单元格

PS

您可以同时生成一个文件列表以及文件夹中的所有计数，只需在closures文件之前将此行添加到代码中：

 oWsTarget.Range("A"& k).Value= fl.Name