excel 遍历文件夹 宏命令
\u5982\u4f55\u904d\u5386\u6587\u4ef6\u5939\u4e0b\u6240\u6709excel\u6587\u4ef6\uff1f\u4f7f\u7528excel\u63d0\u53d6\u6587\u4ef6\u5939\u4e2d\u7684\u6240\u6709\u6587\u4ef6\u540d\u79f0\u7684\u65b9\u6cd5\u4e3b\u8981\u6709\u4ee5\u4e0b\u4e24\u4e2a\uff1a
1\u3001\u5728\u90a3\u4e2a\u6587\u4ef6\u5939\u5185\u65b0\u5efa\u4e00\u4e2a.TXT\u6587\u4ef6\uff08\u5982wenjian.txt\uff09\uff0c\u7528\u8bb0\u4e8b\u672c\u5355\u5f00\u8f93\u5165
dir> 1.txt
\u4fdd\u5b58\u9000\u51fa
\u5c06\u521a\u624d\u7684.TXT\uff08wenjian.txt\uff09\u66f4\u540d\u4e3a.bat\u6587\u4ef6\uff08wenjian.bat\uff09
\u53cc\u51fbwenjian.bat\u6587\u4ef6\u8fd0\u884c\u4e00\u6b21\uff0c\u5728\u6587\u4ef6\u5939\u5185\u591a\u51fa\u4e00\u4e2a1.txt\u6587\u4ef6
\u6253\u5f001.txt\u6587\u4ef6\uff0c\u5c06\u5176\u4e2d\u7684\u5185\u5bb9\u7c98\u8d34\u5230Excel\u4e2d\uff0c\u6570\u636e\u2014\u2014\u5206\u5217\u5904\u7406\u5c31\u53ef\u4ee5\u5f97\u5230\u4f60\u8981\u7684\u6587\u4ef6\u540d\u5217\u8868\u4e86\uff01
2\u3001VBA\uff082003\u7248\uff09
\u5728\u90a3\u4e2a\u6587\u4ef6\u5939\u4e0b\u65b0\u5efaExcel\u6587\u4ef6\uff0c\u6253\u5f00\u65b0\u5efa\u7684Excel\u6587\u4ef6\uff0c\u53f3\u51fb\u5de5\u4f5c\u8868\u6807\u7b7e\uff08\u5982Sheet1\uff09\uff0c\u67e5\u770b\u4ee3\u7801\u2014\u2014\u5728\u4ee3\u7801\u7f16\u8f91\u5668\u4e2d\u8f93\u5165\u4ee5\u4e0b\u4ee3\u7801
Sub Test()
Dim i As Integer
Dim strPath As String
strPath = ThisWorkbook.Path
With Application.FileSearch
.LookIn = strPath
.SearchSubFolders = True
.Filename = "*.*"
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Range("A" & i) = .FoundFiles(i)
Next i
End If
End With
End Sub
\u56de\u5230Excel\u8868\u683c\u4e2d\uff0c\u5de5\u5177\u2014\u2014\u5b8f\u2014\u2014\u5b8f\u2014\u2014\u9009\u62e9Sheet1.Test\u2014\u2014\u6267\u884c
\u65b9\u6cd5\u4e00\u7b80\u5355\u7684\u64cd\u4f5c\u5c31\u53ef\u4ee5\uff0c\u65b9\u6cd5\u4e8c\u9700\u8981\u5bf9\u7a0b\u5e8f\u6709\u4e00\u5b9a\u7684\u4e86\u89e3\uff0c\u65b9\u6cd5\u4e8c\u901a\u7528\u6027\u6bd4\u8f83\u5f3a\uff0c\u9700\u8981\u7684\u65f6\u5019\u6267\u884c\u4e00\u4e0b\u5c31\u53ef\u4ee5\uff0c\u66f4\u5feb\u6377\u3002
\u4e0b\u9762\u7684\u4ee3\u7801\u662f\u624b\u5de5\u7801\u7684\uff0c\u4e0d\u6653\u5f97\u6709\u6ca1\u6709\u95ee\u9898\u3002
sub test()dim f as string,mPath as string,Wb as workbook,Sh as workSheetif workbooks.count>1 then msgbox "\u5173\u95ed\u5176\u4ed6\u5de5\u4f5c\u7c3f\uff01":exit submPath = "D:\\u4e34\u65f6\u6587\u4ef6\u5939\" '\u6307\u5b9a\u8def\u5f84\uff0c\u6ce8\u610f\u5206\u5c42\u6807\u8bb0\f=dir(mPath & "*.xls*")do while f"" if fthisworkbook.name then set Wb=workbooks.open(mPath & f) '\u53ea\u8bfb\u65b9\u5f0f\u6253\u5f00 with Wb for each Sh in .workSheets '\u5bf9\u5de5\u4f5c\u8868\u8fdb\u884c\u64cd\u4f5c\u7684\u4ee3\u7801\u6bb5\uff0c\u81ea\u5df1\u5199\u3002 next end with wb.close 0 '\u5173\u95ed\u6587\u4ef6 end iff=dir '\u679a\u4e3e,\u4ee5\u8bbf\u95ee\u4e0b\u4e00\u4e2a\u5de5\u4f5c\u7c3f\u3002loopend sub
1、filesearch法
Sub test3()
Dim wb As Workbook
Dim i As Long
Dim t
t = Timer
With Application.FileSearch '调用fileserch对象
.NewSearch '开始新的搜索
.LookIn = ThisWorkbook.path '设置搜索的路径
.SearchSubFolders = True '搜索范围包括 LookIn 属性指定的文件夹中的所有子文件夹
.Filename = "*.xls" '设置搜索的文件类型
' .FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then '如果找到文件
For i = 1 To .FoundFiles.Count
'On Error Resume Next
Cells(i, 1) = .FoundFiles(i) '把找到的文件放在单元格里
Next i
Else
MsgBox "没找到文件"
End If
End With
MsgBox Timer - t
End Sub
2、递归法
Sub Test()
Dim iPath As String, i As Long
Dim t
t = Timer
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "请选择要查找的文件夹"
If .Show Then
iPath = .SelectedItems(1)
End If
End With
If iPath = "False" Or Len(iPath) = 0 Then Exit Sub
i = 1
Call GetFolderFile(iPath, i)
MsgBox Timer - t
MsgBox "文件名链接获取完毕。", vbOKOnly, "提示"
End Sub
Private Sub GetFolderFile(ByVal nPath As String, ByRef iCount As Long)
Dim iFileSys
'Dim iFile As Files, gFile As File
'Dim iFolder As Folder, sFolder As Folders, nFolder As Folder
Set iFileSys = CreateObject("Scripting.FileSystemObject")
Set iFolder = iFileSys.GetFolder(nPath)
Set sFolder = iFolder.SubFolders
Set iFile = iFolder.Files
With ActiveSheet
For Each gFile In iFile
' .Hyperlinks.Add anchor:=.Cells(iCount, 1), Address:=gFile.path, TextToDisplay:=gFile.Name
iCount = iCount + 1
Next
End With
'递归遍历所有子文件夹
For Each nFolder In sFolder
Call GetFolderFile(nFolder.path, iCount)
Next
End Sub
3、dir循环法
Sub Test() '使用双字典，旨在提高速度
Dim MyName, Dic, Did, i, t, F, TT, MyFileName
'On Error Resume Next
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "选择文件夹", 0, 0)
If Not objFolder Is Nothing Then lj = objFolder.self.path & "\"
Set objFolder = Nothing
Set objShell = Nothing
t = Time
Set Dic = CreateObject("Scripting.Dictionary") '创建一个字典对象
Set Did = CreateObject("Scripting.Dictionary")
Dic.Add (lj), ""
i = 0
Do While i < Dic.Count
Ke = Dic.keys '开始遍历字典
MyName = Dir(Ke(i), vbDirectory) '查找目录
Do While MyName <> ""
If MyName <> "." And MyName <> ".." Then
If (GetAttr(Ke(i) & MyName) And vbDirectory) = vbDirectory Then '如果是次级目录
Dic.Add (Ke(i) & MyName & "\"), "" '就往字典中添加这个次级目录名作为一个条目
End If
End If
MyName = Dir '继续遍历寻找
Loop
i = i + 1
Loop
Did.Add ("文件清单"), "" '以查找D盘下所有EXCEL文件为例
For Each Ke In Dic.keys
MyFileName = Dir(Ke & "*.xls")
Do While MyFileName <> ""
Did.Add (Ke & MyFileName), ""
MyFileName = Dir
Loop
Next
For Each Sh In ThisWorkbook.Worksheets
If Sh.Name = "XLS文件清单" Then
Sheets("XLS文件清单").Cells.Delete
F = True
Exit For
Else
F = False
End If
Next
If Not F Then
Sheets.Add.Name = "XLS文件清单"
End If
Sheets("XLS文件清单").[A1].Resize(Did.Count, 1) = WorksheetFunction.Transpose(Did.keys)
TT = Time - t
MsgBox Minute(TT) & "分" & Second(TT) & "秒"
End Sub
Sub test()
Application.ScreenUpdating = False
fpath = "D:\a\" '修改为实际文件夹
fname = Dir(fpath & "*.xls")
i = 1
Do While fname <> ""
Set xlbook = Workbooks.Open(fpath & fname)
tmp = Application.WorksheetFunction.Sum(Range("C:C"))
xlbook.Close (False)
Cells(i, 1) = fname
Cells(i, 2) = tmp
i = i + 1
fname = Dir
Loop
Application.ScreenUpdating = True
End Sub
给我联系方式，我可以帮你
扩展阅读：表格制作目录及超链接 ... vba 遍历文件夹的excel ... 22个常用宏命令 ... 一键批量修改文件名 ... 生成文件夹目录清单 ... python遍历拆分excel ... vba遍历文件夹并提取 ... python遍历excel数据 ... 多个excel 文件 查询 ...
