收费抽奖网站,龙华做网站哪家便宜,简洁的网站案例,地瓜互联 wordpress1.新建一个excel表格。并创建两个Sheet#xff0c;名字分别命名为FileList 和 All information。 2.按ALTF11进入 VBA编程模块#xff0c;插入模块。 3.将如下 第五部分代码复制到模块中。 点击运行即可#xff0c;然后就能提取指定目录下的所有excel文件信息并合并到一起…1.新建一个excel表格。并创建两个Sheet名字分别命名为FileList 和 All information。 2.按ALTF11进入 VBA编程模块插入模块。 3.将如下 第五部分代码复制到模块中。 点击运行即可然后就能提取指定目录下的所有excel文件信息并合并到一起输出到“All information” 中。 4.运行过程中在弹窗中输入 想要提取信息的路径地址。 5.说明
这个脚本的逻辑分为两部分
首先是提取文件夹中所有文件的基本信息并将其填充到FileList工作表中。之后它将这些文件打开并将它们的内容合并到All information工作表中。
Sub CombinedScript()Application.DisplayAlerts FalseApplication.ScreenUpdating FalseOn Error Resume Next Step 1: Extracting files from foldersDim arr(1 To 10000) As StringDim arr1(1 To 100000, 1 To 6) As StringDim fso As Object, myfile As ObjectDim f, i, k, f2, f3, xDim q As Integerarr(1) Application.InputBox(Please enter the path to scan) \i 1k 1Do While i UBound(arr)If arr(i) Then Exit Dof Dir(arr(i), vbDirectory)DoIf InStr(f, .) 0 And f Thenk k 1arr(k) arr(i) f \End Iff DirLoop Until f i i 1Loop Extract files informationSet fso CreateObject(Scripting.FileSystemObject)For x 1 To UBound(arr)If arr(x) Then Exit Forf3 Dir(arr(x) *.*)Do While f3 If InStr(f3, .) 0 Thenq q 1arr1(q, 5) arr(x) f3Set myfile fso.GetFile(arr1(q, 5))arr1(q, 1) f3arr1(q, 2) myfile.Sizearr1(q, 3) myfile.DateCreatedarr1(q, 4) myfile.DateLastModifiedarr1(q, 6) myfile.DateLastAccessedEnd Iff3 DirLoopNext xSheets(FileList).Range(A2).Resize(1000, 6).ClearContentsSheets(FileList).Range(A2).Resize(q, 6) arr1 Step 2: Combine information into All information sheetIf Sheets(All information).FilterMode True ThenSheets(All information).ShowAllDataEnd IfSheets(All information).Range(A2:ZZ100000).ClearContentsDim currentFile As ObjectDim targetRow As IntegerDim temRowCount As IntegertargetRow 2For fileCount 2 To Sheets(FileList).Cells(10000, 1).End(xlUp).RowSet currentFile Application.Workbooks.Open(Sheets(FileList).Cells(fileCount, 5))For sheetscount 1 To currentFile.Sheets.CounttemRowCount currentFile.Sheets(sheetscount).UsedRange.Rows.Count Copy contentcurrentFile.Sheets(sheetscount).UsedRange.CopyThisWorkbook.Sheets(All information).Cells(targetRow, 3).PasteSpecial (xlPasteValues) Set sheet and workbook informationThisWorkbook.Sheets(All information).Range(A targetRow :A targetRow temRowCount).Value currentFile.NameThisWorkbook.Sheets(All information).Range(B targetRow :B targetRow temRowCount).Value currentFile.Sheets(sheetscount).NametargetRow targetRow temRowCountNext sheetscountcurrentFile.Close FalseNext fileCountApplication.DisplayAlerts TrueApplication.ScreenUpdating True
End Sub
