VBA汇总同目录下的所有工作簿数据到另一个工作簿，并进行统计

Sub clData() Dim ComputerCount As Object tms = Timer p = ThisWorkbook.Path & "\" f = Dir(p & "*.xls") Application.ScreenUpdating = False tms = Timer On Error Resume Next Set Rng = ThisWorkbook.Sheets("sheet1") Rng.Range("a2:c65536").ClearContents Do While f <> "" If f <> ThisWorkbook.Name Then fn = fn + 1 Set wb = GetObject(p & f) With wb.Sheets("sheet2") rw = .Range("a65536").End(xlUp).Row trw = Rng.Range("a65536").End(xlUp).Row + 1 For i = 1 To rw GetData = .Range("A" & i & ":C" & i).Value Rng.Range("A" & trw & ":C" & trw) = GetData Next End With End If f = Dir Loop Call tj Set wb = Nothing MsgBox “总共找到 " & fn & "个文件，共有" & trw - 2 & "条记录，用时" & Timer - tms & "秒” & t1 Application.ScreenUpdating = True Exi: End Sub Sub tj() Set Rng = ThisWorkbook.Sheets("sheet1") r = Rng.Range("a65536").End(xlUp).Row Dim a%, b%, c%, d%, e%, t% a = 0 b = 0 c = 0 d = 0 e = 0 'Clear Background Color For n = 2 To 65536 Rng.Range("A" & n).Interior.ColorIndex = xlNone Rng.Range("B" & n).Interior.ColorIndex = xlNone Rng.Range("C" & n).Interior.ColorIndex = xlNone Next n For i = 2 To r If Rng.Range("C" & i).Value = "groupA" Then a = a + 1 If Rng.Range("C" & i).Value = "groupB" Then b = b + 1 If Rng.Range("C" & i).Value = "groupC" Then c = c + 1 If Rng.Range("C" & i).Value = "groupD" Then d = d + 1 If Rng.Range("C" & i).Value = "groupE" Then e = e + 1 p = i Mod 2 If p = 0 Then Rng.Range("A" & i).Interior.ColorIndex = 15 Rng.Range("B" & i).Interior.ColorIndex = 15 Rng.Range("C" & i).Interior.ColorIndex = 15 Else Rng.Range("A" & i).Interior.ColorIndex = 2 Rng.Range("B" & i).Interior.ColorIndex = 2 Rng.Range("C" & i).Interior.ColorIndex = 2 End If Next i Rng.Range("H2").Value = a Rng.Range("H3").Value = b Rng.Range("H4").Value = c Rng.Range("H5").Value = d Rng.Range("H6").Value = e Rng.Range("H7").Value = a + b + c + d + e 'Total End Sub

 

转载于:https://www.cnblogs.com/luoye00/p/10149659.html

相关资源：VBA宏汇总同文件夹下多工作簿数据