|
本帖最后由 lsc900707 于 2016-12-2 21:53 编辑
不上传数据文件,就只能试试看,把标红的地方改成你自己的文件夹名:
Sub lsc()
Dim tim1 As Date, tim2 As Date: tim1 = Timer
Dim mypath, myfile, m, j, wb, arr()
mypath = ThisWorkbook.Path & "\新建文件夹\"
myfile = Dir(mypath, vbDirectory)
Do While myfile <> ""
If myfile <> "." And myfile <> ".." Then
If GetAttr(mypath & myfile) = vbDirectory Then
m = m + 1
ReDim Preserve arr(m)
arr(m) = mypath & myfile & "\"
End If
End If
myfile = Dir
Loop
For j = 1 To m
myfile = Dir(arr(j) & ".xls*")
While myfile <> ""
Set wb = CreateObject(arr(j) & myfile)
For Each sh In wb.Sheets
sh.UsedRange.value= sh.UsedRange.Value
Next
wb.Close
myfile = Dir()
Wend
Next
Set wb = Nothing
tim2 = Timer
MsgBox Format(tim2 - tim1, "亲,修改完成,耗时:0.00秒"), 64, "温馨提示"
End Sub |
|