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