vba 跨文件统计

最新推荐文章于 2023-08-01 13:53:16 发布

火鸡味锅巴

最新推荐文章于 2023-08-01 13:53:16 发布

阅读量488

点赞数

文章标签： vba excel 宏

本文链接：https://blog.csdn.net/u012514724/article/details/54708997

版权

Sub test()
Dim path As String, name As String
Dim sht As Worksheet
Dim i As Integer, arr()
Dim rng As Range
i = 1
    path = "D:\vbatest\checked"
    path = path & IIf(Right(path, 1) = "\", "", "\")
    name = Dir(path & "*.xls*")

ReDim Preserve arr(1 To 5, 1 To 1)

    arr(1, 1) = "儌僕儏乕儖柤"
    arr(2, 1) = "OK悢"
    arr(3, 1) = "NG悢"
    arr(4, 1) = "NG->OK悢"
    arr(5, 1) = "憤case悢"

    Application.ScreenUpdating = False
    Do
        If Len(name) = 0 Then Exit Do
        If InStr(1, name, "_扨懱") > 0 Then
            With Workbooks.Open(path & name)
                Set sht = .Worksheets(2)
                i = i + 1
                ReDim Preserve arr(1 To 5, 1 To i)
                arr(1, i) = Left(name, InStr(1, name, "_扨懱") - 1)
                Set rng = Range("BR1:BR" & sht.UsedRange.Rows.Count)
                arr(2, i) = Application.WorksheetFunction.CountIf(rng, "OK")
                arr(3, i) = Application.WorksheetFunction.CountIf(rng, "NG")
                arr(4, i) = Application.WorksheetFunction.CountIf(rng, "*NG*OK*")
                arr(5, i) = arr(2, i) + arr(3, i) + arr(4, i)
            End With
            Workbooks(name).Close , False
        End If
    name = Dir
    Loop

path = "D:\vbatest\batch"
path = path & IIf(Right(path, 1) = "\", "", "\")
name = Dir(path & "*.xls*")
    Do
        If Len(name) = 0 Then Exit Do
        If InStr(1, name, "_扨懱") > 0 Then
            With Workbooks.Open(path & name)
                Set sht = .Worksheets(1)
                i = i + 1
                ReDim Preserve arr(1 To 5, 1 To i)
                arr(1, i) = Left(name, InStr(1, name, "_扨懱") - 1)
                'Dim rng As Range
                Set rng = Range("BR1:BR" & sht.UsedRange.Rows.Count)
                arr(2, i) = Application.WorksheetFunction.CountIf(rng, "OK")
                arr(3, i) = Application.WorksheetFunction.CountIf(rng, "NG")
                arr(4, i) = Application.WorksheetFunction.CountIf(rng, "*NG*OK*")
                arr(5, i) = arr(2, i) + arr(3, i) + arr(4, i)
            End With
            Workbooks(name).Close , False
        End If
    name = Dir
    Loop

For x = 1 To UBound(arr, 2)
    For y = 1 To UBound(arr, 1)
        Cells(x, y) = arr(y, x)
    Next y
Next x
    Set rng = Range("E2:E" & x - 1)
    Cells(x, 5) = Application.WorksheetFunction.Sum(rng)
 Application.ScreenUpdating = True
End Sub