vba怎么批量提取很多个工作簿中固定列的某个数据，统计他的数量然后汇总到一个新表中？

Question

本人VBA初学，不知道这个要求能不能用vba实现

有几百个同格式的工作簿，每天还在增加，里面只有一张表，表的格式都是固定的，需要提取表中B列某个数据的数量 然后汇总到一个新表中，每个表中B列的行数不等，基本都在几百上千行

表一  B列                       表二  B列                       表三    B列 

          PASS                            PASS                                 PASS

          PASS                           dead                                   PASS

          dead                            dead                                     PASS

          DLD dead                   DLD dead                          dead

需要汇总的新表格式

     表名          PASS    dead    DLD dead

      表一          2             1                 1

     表二          1              2                 1

     表三          3              1                 0

 我不知道怎么实现，不知道这个难不难，有没有大哥给串代码

 

 

Answer 1

如果写VBS：
Sub a()
    Dim fso
    Dim fld
    Dim fil
    Dim xls
    Dim bok
    Dim sht
    Dim i
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder("C:\Users\king\Documents\")
    Set xls = CreateObject("Excel.Application")
    
    i = 1
    For Each fil In fld.Files
        If LCase(Right(fil.Name, 4)) = ".xls" Or LCase(Right(fil.Name, 5)) = ".xlsx" Then
            Debug.Print (fil.Name)
            i = i + 1
            Set bok = xls.Workbooks.Open(fil.Path, ReadOnly = True)
            Set sht = bok.Sheets(1)
            Sheet1.Cells(i, 1).Value = fil.Name
            Sheet1.Cells(i, 2).Value = sht.Evaluate("=COUNTIF(B:B,""PASS"")")
            Sheet1.Cells(i, 3).Value = sht.Evaluate("=COUNTIF(B:B,""dead"")")
            Sheet1.Cells(i, 4).Value = sht.Evaluate("=COUNTIF(B:B,""DLD dead"")")
            bok.Close
        End If
    Next
End Sub