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

时间:2016-10-14 21:06:31

标签: excel vba excel-vba macros

Previous Post

我需要创建一个宏来循环遍历单个文件夹中的文件并运行我在下面提供的代码。所有文件的结构方式相同,但具有不同的数据。代码可以帮助我转到指定的目标文件并计算" YES"在专栏中。然后它将它输出到CountResults.xlsm(主工作簿)。在Zac的帮助下,我有以下代码:

var graphdata={data1:[100,200,300],data2:[150,220,330]};
var chart = c3.generate({
    data: {
        types: {data1:'spline',
            data2:'bar'
        },
        json: graphdata,
    },
    bar: {
        width: {
            ratio: 0.5
        }
    }
});

这就是CountResults.xlsm(主工作簿)的样子:

CountResults.xlsm

而且,这是Test01.xlsx的示例:

Test01.xlsx

要注意,有10个测试文件(Test01,Test02 ......),但代码应该能够更新添加的任何新测试文件(例如Test11,Test12 ......)。我想到了合并"文件"第一个图像中的列,用于拉取文件名并循环它们。

2 个答案:

答案 0 :(得分:1)

最简单的方法是使用filesystemobject遍历文件夹中的所有文件,找到文件名类似于预定义掩码的文件(在您的情况下为“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

如果此答案有帮助,请标记为已接受。另请注意,您的原始代码将在循环的每次迭代中替换主电子表格中B2单元格的值,这就是我在每次迭代后添加k变量以更改目标单元格的原因

P.S。

您可以同时生成文件列表以及文件夹中的yes计数,只需在关闭文件之前将此行添加到代码中:

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

答案 1 :(得分:0)

最简单的方法是将代码转换为函数。

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