|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub text()
Application.ScreenUpdating = False
Dim MyDir, MyName, ar, br(), n%
MyName = ThisWorkbook.Path & "/\各单位报表/"
MyDir = Dir(MyName & "/*.xls")
While MyDir <> ""
With Workbooks.Open(MyName & MyDir)
ar = .Sheets(1).Cells(1, 1).CurrentRegion
.Close False
End With
For i = 1 To UBound(ar)
If InStr(ar(i, 4), "优秀") Then
n = n + 1
ReDim Preserve br(1 To 4, 1 To n)
br(1, n) = n
br(2, n) = ar(i, 2)
br(3, n) = ar(i, 3)
br(4, n) = ar(i, 4)
End If
Next
MyDir = Dir
Wend
[a3].Resize(n, 4) = Application.Transpose(br)
Application.ScreenUpdating = True
End Sub
|
|