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