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

本人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

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

 

 

如果写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
 

xlsm宏代码,统计结果直接写入xlsm文件第一个工作表中

 


Sub Summary()
  Dim path As String
  Dim f As String
  Dim filepath As String
  Dim rownum As Integer
  Dim i As Integer
  Dim row As Integer
  Dim pass As Integer
  Dim dead As Integer
  Dim dlddead As Integer
  
  Dim cellvalue As String
  
  
  row = 1
  
  '给当前存储vba代码的xlsm文件表写入标题
  ThisWorkbook.Sheets(1).Cells(row, "A") = "表名"
  ThisWorkbook.Sheets(1).Cells(row, "B") = "PASS"
  ThisWorkbook.Sheets(1).Cells(row, "C") = "dead"
  ThisWorkbook.Sheets(1).Cells(row, "D") = "DLD dead"
  row = row + 1
  
  
  path = "C:\Users\showbo\Desktop\vba\excels\" ''''''''''注意改这里为你存储Excel文件的路径
  
  
  f = Dir(path & "*.*") '找目录中的文件
  Do Until f = ""
     filepath = path & f 'Excel文件路径,注意f只是文件名
     pass = 0
     dead = 0
     dlddead = 0
     Workbooks.Open Filename:=filepath, ReadOnly:=True'打开Excel
     rownum = Sheets(1).Range("B65536").End(xlUp).row '找到表1中有多少行数据
     For i = 1 To rownum '遍历数据行
       cellvalue = Sheets(1).Cells(i, "B")
       If cellvalue = "PASS" Then
          pass = pass + 1
       ElseIf cellvalue = "dead" Then
          dead = dead + 1
       ElseIf cellvalue = "DLD dead" Then
          dlddead = dlddead + 1
       End If
       
     Next i
     
     '写入遍历到的Excel文件的统计内容到xlsm
     ThisWorkbook.Sheets(1).Cells(row, "A") = f
     ThisWorkbook.Sheets(1).Cells(row, "B") = pass
     ThisWorkbook.Sheets(1).Cells(row, "C") = dead
     ThisWorkbook.Sheets(1).Cells(row, "D") = dlddead
  
     row = row + 1
     
     Workbooks(2).Close SaveChanges:=False '关闭打开的Excel
     
    
     
     f = Dir '继续遍历下一个文件
   Loop


End Sub

 

Sub a()
    Dim fso 
    Dim fld 
    Dim fil 
    Dim xls 
    Dim bok 
    Dim sht 
    Dim i 
    
    Set fso = New Scripting.FileSystemObject
    Set fld = fso.GetFolder("C:\Users\king\Documents\")
    Set xls = New 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

但求一个大哥

都是编程语言,用python比较容易实现

有没有兄弟写下代码,然后告诉下代码意思不的,刚接触vba

需要填加引用:
工具/引用/Microsoft Scripting runtime