|
遍歷是我們常用的一種方式,，下面介紹5種場景的文件遍歷，代碼案例在文末,，大家自行下載,，自己按照各自需求修改： 【一、遍歷當(dāng)前文件夾下一層子文件夾】 Sub 按鈕1_Click() Application.ScreenUpdating = False Set fso = CreateObject('scripting.filesystemobject') Set ff = fso.getfolder(ThisWorkbook.Path) 'ThisWorkbook.Path是當(dāng)前代碼文件所在路徑,，路徑名可以根據(jù)需求修改 ActiveSheet.UsedRange.ClearContents a = 1 For Each fd In ff.subfolders Cells(a, 1) = fd.Name '子文件夾名,相對于當(dāng)前文件夾的名字 Cells(a, 2) = fd '子文件夾全路徑 a = a + 1 Next fd Application.ScreenUpdating = True End Sub 【二,、遍歷當(dāng)前文件夾文件名】 Sub 按鈕1_Click() Application.ScreenUpdating = False Set fso = CreateObject('scripting.filesystemobject') Set ff = fso.getfolder(ThisWorkbook.Path) 'ThisWorkbook.Path是當(dāng)前代碼文件所在路徑，路徑名可以根據(jù)需求修改 ActiveSheet.UsedRange.ClearContents a = 1 For Each f In ff.Files Rem 如果不需要提取本代碼文件名,，可以增加if語句 if f.name<> thisworkbook.name then..... Rem 如果值需要提取某類文件,，需要對f.name的擴(kuò)展名進(jìn)行判斷 Rem 個(gè)人感覺split取 擴(kuò)展名：split（f.name,'.')(ubound（split（f.name,'.')）),，然后再判斷，避免文件名還有其他“.” Cells(a, 1) = f.Name '相對路徑名 Cells(a, 2) = f '全路徑名 a = a + 1 Next f Application.ScreenUpdating = True End Sub 【三,、遍歷當(dāng)前文件夾所有子文件夾】 Sub 按鈕1_Click() Application.ScreenUpdating = False ActiveSheet.UsedRange.ClearContents Cells(1, 1) = '文件夾名' Getfd (ThisWorkbook.Path) 'ThisWorkbook.Path是當(dāng)前代碼文件所在路徑,，路徑名可以根據(jù)需求修改 Application.ScreenUpdating = True End Sub Sub Getfd(ByVal pth) Set Fso = CreateObject('scripting.filesystemobject') Set ff = Fso.getfolder(pth) Cells(Rows.Count, 1).End(3).Offset(1) = pth For Each fd In ff.subfolders Getfd (fd) Next fd End Sub 【四、遍歷當(dāng)前文件夾及所有子文件夾下的文件】 Sub 按鈕1_Click() Application.ScreenUpdating = False ActiveSheet.UsedRange.ClearContents Cells(1, 1) = '相對路徑文件名' Cells(1, 2) = '絕對路徑文件名' Getfd (ThisWorkbook.Path) 'ThisWorkbook.Path是當(dāng)前代碼文件所在路徑,，路徑名可以根據(jù)需求修改 Application.ScreenUpdating = True End Sub Sub Getfd(ByVal pth) Set Fso = CreateObject('scripting.filesystemobject') Set ff = Fso.getfolder(pth) For Each f In ff.Files Rem 具體提取哪類文件,，還是需要根據(jù)文件擴(kuò)展名進(jìn)行處理 Cells(Rows.Count, 1).End(3).Offset(1) = f.Name Cells(Rows.Count, 2).End(3).Offset(1) = f Next f For Each fd In ff.subfolders Getfd (fd) Next fd End Sub 【五、匯總當(dāng)前文件夾及子文件夾下所有excel文件內(nèi)容】 Public d Sub 按鈕1_Click() Application.ScreenUpdating = False ActiveSheet.UsedRange.ClearContents Cells(1, 1) = '編號(hào)' Cells(1, 2) = '數(shù)量' Set d = CreateObject('scripting.dictionary') Getfd (ThisWorkbook.Path) 'ThisWorkbook.Path是當(dāng)前代碼文件所在路徑,，路徑名可以根據(jù)需求修改 Application.ScreenUpdating = True If d.Count > 0 Then ThisWorkbook.Sheets(1).[a2].Resize(d.Count) = WorksheetFunction.Transpose(d.keys) ThisWorkbook.Sheets(1).[b2].Resize(d.Count) = WorksheetFunction.Transpose(d.items) End If End Sub Sub Getfd(ByVal pth) Set Fso = CreateObject('scripting.filesystemobject') Set ff = Fso.getfolder(pth) For Each f In ff.Files Rem 具體提取哪類文件,，還是需要根據(jù)文件擴(kuò)展名進(jìn)行處理 If InStr(Split(f.Name, '.')(UBound(Split(f.Name, '.'))), 'xl') > 0 Then If f.Name <> ThisWorkbook.Name Then Set wb = Workbooks.Open(f) For Each sht In wb.Sheets If WorksheetFunction.CountA(sht.UsedRange) > 1 Then arr = sht.UsedRange For j = 2 To UBound(arr) d(arr(j, 1)) = d(arr(j, 1)) + arr(j, 2) Next j End If Next sht wb.Close False End If End If Next f For Each fd In ff.subfolders Getfd (fd) Next fd End Sub 點(diǎn)個(gè)在看你最好看   |
|
|
