背景:
1. 被汇总的数据源Excel文件,分布在不同层级的子文件夹当中
2. 每个数据源Excel文件叫不同的名字,每个文件含有不同的工作表名字
3. 需要被汇总的工作表,有相同的格式
Public fso
Sub ListFiles() ' 汇总
Set fso = CreateObject("Scripting.FileSystemObject")
Sheet1.Range("A2").Resize(10000, 14).ClearContents
GetAllFiles (ThisWorkbook.Path) '对Excel文件及子目录中的文件,进行列表
r = 2
For i = 2 To Sheet1.[A100000].End(xlUp).Row '循环打开每个列表上的Excel文件
Set wb = Workbooks.Open(Sheet1.Cells(i, 1))
For Each s In wb.Sheets '遍历当前文件所有工作表
Set c = s.[B:B].Find(What:="No.") ' 查找格式数据是否存在
If c Is Nothing Then GoTo nx '不存在继续下一个表
For k = c.Row + 1 To s.[B100000].End(xlUp).Row '读表到汇总页
Sheet1.Cells(r, 2) = Sheet1.Cells(i, 1)
Sheet1.Cells(r, 3) = s.Name
Sheet1.Cells(r, 4) = s.Cells(k, 2)
Sheet1.Cells(r, 5) = s.Cells(k, 3)
Sheet1.Cells(r, 6) = s.Cells(k, 4)
Sheet1.Cells(r, 7) = s.Cells(k, 5)
Sheet1.Cells(r, 8) = s.Cells(k, 6)
Sheet1.Cells(r, 9) = s.Cells(k, 7)
Sheet1.Cells(r, 10) = s.Cells(k, 8)
Sheet1.Cells(r, 11) = s.Cells(k, 9)
Sheet1.Cells(r, 12) = s.Cells(k, 10)
DoEvents
r = r + 1
Next
nx:
Next
Application.DisplayAlerts = False
wb.Close
Application.DisplayAlerts = True
Next
End Sub
Function GetAllFiles(fp$) ' 对当前目录及所有子目录中的Excel文件列表
Dim fn, n
n = Dir(fp & "\")
Do While Len(n) <> 0
If UCase(n) Like "*.XLS" Or UCase(n) Like "*.XLSX" Then
Sheet1.[A65536].End(3)(2) = fp & "\" & n
Sheet1.Hyperlinks.Add anchor:=Sheet1.[A65536].End(3)(1), Address:=fp & "\" & n
End If
n = Dir
Loop
For Each fn In fso.getfolder(fp).subfolders
GetAllFiles (fn)
Next
End Function
上述vba代码,除了使用变量、循环判断基本语句之外,剩下的80%都是在使用Excel的对象属性和方法。
那,学好使用对象属性和方法,是不是掌握了VBA的80%, 可以这样说吗?
本例中使用的对象的属性和方法,全部记录在下贴之中:
#EXCEL VBA对象的常用操作方法c# - https://tieba.baidu.com/p/8848588841
1. 被汇总的数据源Excel文件,分布在不同层级的子文件夹当中
2. 每个数据源Excel文件叫不同的名字,每个文件含有不同的工作表名字
3. 需要被汇总的工作表,有相同的格式
Public fso
Sub ListFiles() ' 汇总
Set fso = CreateObject("Scripting.FileSystemObject")
Sheet1.Range("A2").Resize(10000, 14).ClearContents
GetAllFiles (ThisWorkbook.Path) '对Excel文件及子目录中的文件,进行列表
r = 2
For i = 2 To Sheet1.[A100000].End(xlUp).Row '循环打开每个列表上的Excel文件
Set wb = Workbooks.Open(Sheet1.Cells(i, 1))
For Each s In wb.Sheets '遍历当前文件所有工作表
Set c = s.[B:B].Find(What:="No.") ' 查找格式数据是否存在
If c Is Nothing Then GoTo nx '不存在继续下一个表
For k = c.Row + 1 To s.[B100000].End(xlUp).Row '读表到汇总页
Sheet1.Cells(r, 2) = Sheet1.Cells(i, 1)
Sheet1.Cells(r, 3) = s.Name
Sheet1.Cells(r, 4) = s.Cells(k, 2)
Sheet1.Cells(r, 5) = s.Cells(k, 3)
Sheet1.Cells(r, 6) = s.Cells(k, 4)
Sheet1.Cells(r, 7) = s.Cells(k, 5)
Sheet1.Cells(r, 8) = s.Cells(k, 6)
Sheet1.Cells(r, 9) = s.Cells(k, 7)
Sheet1.Cells(r, 10) = s.Cells(k, 8)
Sheet1.Cells(r, 11) = s.Cells(k, 9)
Sheet1.Cells(r, 12) = s.Cells(k, 10)
DoEvents
r = r + 1
Next
nx:
Next
Application.DisplayAlerts = False
wb.Close
Application.DisplayAlerts = True
Next
End Sub
Function GetAllFiles(fp$) ' 对当前目录及所有子目录中的Excel文件列表
Dim fn, n
n = Dir(fp & "\")
Do While Len(n) <> 0
If UCase(n) Like "*.XLS" Or UCase(n) Like "*.XLSX" Then
Sheet1.[A65536].End(3)(2) = fp & "\" & n
Sheet1.Hyperlinks.Add anchor:=Sheet1.[A65536].End(3)(1), Address:=fp & "\" & n
End If
n = Dir
Loop
For Each fn In fso.getfolder(fp).subfolders
GetAllFiles (fn)
Next
End Function
上述vba代码,除了使用变量、循环判断基本语句之外,剩下的80%都是在使用Excel的对象属性和方法。
那,学好使用对象属性和方法,是不是掌握了VBA的80%, 可以这样说吗?
本例中使用的对象的属性和方法,全部记录在下贴之中:
#EXCEL VBA对象的常用操作方法c# - https://tieba.baidu.com/p/8848588841