2020-08-14

Sub 报告()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Dim mb As Workbook, nb As Workbook
    Dim i As Integer, j&, n&
    Dim myfile$, mypath$
    Dim t#, l#, w#, h#
    Dim arr(1 To 62, 1 To 14)
    Dim rng As Range
    mypath = ThisWorkbook.Path & "\"
    Set mb = ThisWorkbook
    myfile = Dir(mypath & "整理后报表\" & "*xlsx")
    While myfile <> ""
        If myfile <> ThisWorkbook.Name Then
            Set nb = Workbooks.Open(mypath & "整理后报表\" & myfile)
            n = n + 1
            For i = 1 To 15
                arr(i, n) = nb.Sheets(1).Cells(i + 13, 3)
            Next
            For i = 16 To 33
                arr(i, n) = nb.Sheets(1).Cells(i + 14, 3)
            Next
            For i = 34 To 36
                arr(i, n) = nb.Sheets(1).Cells(i + 15, 3)
             Next
            For i = 37 To 50
                arr(i, n) = nb.Sheets(1).Cells(i + 28, 3)
            Next
            
            For i = 51 To 54
                arr(i, n) = nb.Sheets(1).Cells(i + 29, 3)
            Next
            For i = 55 To 61
                arr(i, n) = nb.Sheets(1).Cells(i + 30, 3)
            Next
            arr(62, n) = nb.Sheets(1).Range("c4")
            nb.Close False
            myfile = Dir
         End If
    Wend
    mb.Sheets(1).Range("b2").Resize(62, 14) = arr
    For Each rng In Sheet1.UsedRange
        If rng = 0 Then
            rng = "-"
        End If
    Next
End Sub