当前位置: 代码迷 >> VBA >> 就剩上这么几段代码了。有兴趣的帮帮忙。多谢
  详细解决方案

就剩上这么几段代码了。有兴趣的帮帮忙。多谢

热度:3964   发布时间:2013-02-26 00:00:00.0
就剩下这么几段代码了。有兴趣的帮帮忙。谢谢!
    谢谢之前帮忙的老师。就剩下这几段代码了。希望有人能帮忙注释一下。谢谢!!!
一、
VB  code

  Sub Macro1()
    Dim MyPath$, MyName$, sh As Worksheet, arr, i&, m&, lr&
    Set sh = ActiveSheet
    MyPath = ThisWorkbook.Path & "\"
    MyName = Dir$(MyPath & "*.xls")
    Application.ScreenUpdating = False
    sh.UsedRange.Offset(7).Clear
    Do While MyName <> ""
        If MyName <> ThisWorkbook.Name Then
            m = m + 1
            With GetObject(MyPath & MyName)
                If m = 1 Then
                    .Sheets("汇总").UsedRange.Offset(7).Copy sh.[a8]
                    lr = .Sheets("汇总").[a65536].End(xlUp).Row - 1
                Else
                    arr = .Sheets("汇总").UsedRange
                    With sh
                        For j = 3 To UBound(arr, 2)
                            If .Cells(8, j).HasFormula = False Then
                                For i = 8 To lr
                                    If Len(arr(i, j)) Then .Cells(i, j) = .Cells(i, j) + arr(i, j)
                                Next
                            End If
                        Next
                    End With
                End If
                .Close False
            End With
        End If
  相关解决方案