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