|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
'撰写:老朽
'网址:http://Club.ExcelHome.net
'日期:2009-8-30 下午 06:47:53
Sub zldccmx()
Dim Fp, Dic, Fn
Set Dic = CreateObject("Scripting.Dictionary")
Do
Fp = Application.GetOpenFilename("EXCEL 文件(*.xls), *.xl*", , "请选择一个目录")
If Fp = False Then Exit Do
Fp = Left(Fp, InStrRev(Fp, "\"))
Fn = Dir(Fp & "*.xl*")
Do While Fn <> ""
Dic(Fp & Fn) = ""
Fn = Dir
Loop
Loop
If Dic.Count > 0 Then
With Sheets.Add.[a1].Resize(Dic.Count, 1)
.Value = WorksheetFunction.Transpose(Dic.keys)
.Sort [a1]
End With
End If
End Sub |
|