|
本帖最后由 lsc900707 于 2017-8-18 06:45 编辑
你要学会给别人评分:点击帮助者帖子右下角“评分”即可。
Sub lqt()
t = Timer
Dim brr(1 To 100000, 1 To 11)
myPath = ThisWorkbook.Path & "\"
MyName = Dir(myPath & "*.xls*")
Application.ScreenUpdating = False
Do While MyName <> ""
If MyName <> ThisWorkbook.Name Then
n = n + 1
Set sh = GetObject(myPath & MyName).Sheets(1)
Arr = sh.UsedRange
Workbooks(MyName).Close False
For i = 1 To UBound(Arr)
If Len(Arr(i, 1)) <> 0 Then
m = m + 1
For j = 1 To 11
brr(m, j) = Arr(i, j)
Next
End If
Next
End If
MyName = Dir
Loop
Set sh = Nothing
With Sheet1
.Rows("2:100000").ClearContents
.[a2].Resize(m, UBound(brr, 2)).Value = brr
End With
Application.ScreenUpdating = True
MsgBox "汇总了:" & n & "个工作表;共有:" & m & "行数据。" & "用时:" & Format(Timer - t, "0.00") & "秒"
End Sub
|
|