|
- Sub 导入文件()
- Application.ScreenUpdating = False
- Dim Filename, wb As Workbook, Sht As Worksheet
- Filename = Dir(ThisWorkbook.Path & "\*.xls")
- On Error GoTo aa
- Dim brr(1 To 10000, 1 To 30)
- Do While Filename <> ""
- If Filename <> ThisWorkbook.Name Then
- fn = ThisWorkbook.Path & "" & Filename
- Set wb = Workbooks.Open(fn)
- Set Sht = wb.Worksheets("25.用户接入点")
- arr = Sht.Range("a5:u" & Sht.[c65536].End(3).Row)
- wb.Close False
- For i = 1 To UBound(arr)
- If Len(arr(i, 3)) > 0 Then
- n = n + 1
- brr(n, 1) = n
- For j = 2 To UBound(arr, 2)
- brr(n, j) = arr(i, j)
- Next
- End If
- Next
- End If
- aa:
- Filename = Dir
- Loop
- Set Sht = Nothing
- If n > 0 Then
- [a5:u10000].ClearContents
- [a5].Resize(n, UBound(arr, 2)) = brr
- End If
- Application.ScreenUpdating = True
- End Sub
复制代码 |
|