特殊跨工作簿汇总求和

实际工作需要，给各位添麻烦了，  由于是菜鸟代码能备注一下就再好也不过了。

请测试:
Sub Macro1()
    Dim arr(), MyPath$, MyName$, MyFile$, i&, k&, j&, m%, brr, crr(1 To 41, 0), drr(1 To 41, 0)
    Application.ScreenUpdating = False
    MyPath = ThisWorkbook.Path & "\"
    MyName = Dir(MyPath, vbDirectory)
    Do While MyName <> ""
        If MyName <> "." And MyName <> ".." Then
            If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
                m = m + 1
                ReDim Preserve arr(m)
                arr(m) = MyPath & MyName & "\"
            End If
        End If
        MyName = Dir
    Loop
    For k = 1 To m
        MyFile = Dir(arr(k) & "*.xls")
        While MyFile <> ""
            With GetObject(arr(k) & MyFile)
                brr = .Sheets("统计表").Range("C6:E47")
                For i = 1 To 41
                    If Len(brr(i, 1)) Then crr(i, 0) = crr(i, 0) + brr(i, 1)
                    If Len(brr(i, 3)) Then drr(i, 0) = drr(i, 0) + brr(i, 3)
                Next
                .Close False
            End With
            MyFile = Dir()
        Wend
    Next
    [c5].Resize(41) = crr
    [e5].Resize(41) = drr
    Application.ScreenUpdating = True
End Sub

请看附件
统计求和.rar (72.35 KB)

最后统计汇总的那个表， 工作表“统计表” 以A48开始的区域    汇总每个人的建议没有没有实现。
如果能备注一下就再好也不过了，在此谢过了。

[ 本帖最后由 sparkguo 于 2011-8-5 20:04 编辑 ]