|
楼主 |
发表于 2016-11-9 08:27
|
显示全部楼层
使用数组访问多个工作簿进行汇总的解决方案- Sub 数组查找工作簿汇总()
- Dim vReadData As Variant '定义读取工作簿中表的数据的数组变量
- Dim vData As Variant '定义读取工作簿中表的规范格式数据的数组变量
- Dim wWB As Workbook '定义工作簿变量
- Dim sPath As String '定义文件夹变量
- Dim sFile As String '定义文件名变量
- Dim nRow As Double '定义行数变量
- Dim nCol As Integer '定义列数变量
- Dim bAdd As Boolean '定义是否需要作为新记录添加的逻辑变量
- Dim vFill As Variant '定义将要作为查询结果的数组变量
- Dim nFill As Double '定义查询结果数组的行数的变量
- Dim sName As String, sPlace As String, sArea As String, vAge As Variant
- Dim vTitle As Variant '定义标题变量
-
- Application.ScreenUpdating = False '禁止数据更新,避免因数据更新时引起闪屏,提高运行速度
- vTitle = Split("姓名|年龄|籍贯|区域", "|") '将所有标题用|隔开的字符串根据|分离成数组
- sName = Trim([A2]) '获取查询姓名的条件
- sPlace = Trim([A6]) '获取查询籍贯的条件
- sArea = Trim([A8]) '获取查询区域的条件
- vAge = [A4:B4].Value '获取查询年龄的条件
-
- ReDim vFill(1 To 4, 1 To 1) '定义一个4列1行的数组
- '注意:正常填到表格内的数组是按(行,列)来定义的,因为考虑到行数将不断增加,而且数组只能是最后一个维度上进行变化,所以先将行定义在后面
- Set wWB = ThisWorkbook '设置本工作簿的变量
- sPath = wWB.Path & "" '获取本工作簿所在文件夹
- sFile = Dir(sPath & "*.xls*") '查找sPath文件夹内的与xls有关后缀名的文件
- Do While sFile <> "" '如果查找不到相关文件将会返回空字符串,找到的话,将返回文件名的全名
- If sFile <> ThisWorkbook.Name Then '如果找到的文件名不等于本工作簿的文件名
- With Workbooks.Open(sPath & sFile) '打开工作簿sFile
- vReadData = .Sheets(1).UsedRange.Value '将第一个表的所有已用单元格的数值赋值给数组
- .Close False '关闭工作簿sFile
- End With
- vData = 规范数据格式(vReadData, vTitle) '如果所有工作簿内数据格式一致,可以跳过本步,上一步的赋值给vReadData的时候直接赋值给vData即可
- For nRow = 2 To UBound(vData) 'vData中,第1行是标题,故从2行开始读取数据
- bAdd = True '初始化变量为真
- If sName <> "" Then bAdd = bAdd And (vData(nRow, 1) Like "*" & sName & "*")
- '假如存在姓名条件,且姓名类似条件形式,为真,并跟bAdd进行与运算,例如:条件是”张“,那么”张三“就类似”*张*“
- If vAge(1, 2) <> "" Then bAdd = bAdd And Application.Evaluate(vData(nRow, 2) & IIf(vAge(1, 1) = "", "=", vAge(1, 1)) & vAge(1, 2))
- 'Evaluate是计算一个字符串形式的式子的值
- 'IIf(vAge(1, 1) = "", "=", vAge(1, 1)) ,如果年龄的比较符号vAge(1, 1)没有被选择,默认使用等于号
- '整个语句就是当条件中有年龄条件数值,对比数据中年龄vData(nRow, 2)是否符合条件
- If sPlace <> "" Then bAdd = bAdd And (vData(nRow, 1) = sPlace)
- '假如存在籍贯条件,且籍贯与条件相同,为真,并跟bAdd进行与运算
- If sArea <> "" Then bAdd = bAdd And (vData(nRow, 1) = sArea)
- '假如存在区域条件,且区域与条件相同,为真,并跟bAdd进行与运算
- If bAdd Then '假如条件符合判断逻辑变量bAdd为真时
- nFill = nFill + 1 '为查询数据数组的行数增加一行
- ReDim Preserve vFill(1 To 4, 1 To nFill) '为增加一行的查询数据数组重定义
- For nCol = 1 To 4
- vFill(nCol, nFill) = vData(nRow, nCol) '复制符合条件的一行数据到查询数据数组最后一行上
- Next
- End If
- Next
- End If
- sFile = Dir '查询一个符合条件的文件
- Loop
- ThisWorkbook.Activate '本工作簿激活为使用状态
- With Sheets("汇总") '对”汇总“表进行操作
- .[F:I].ClearContents '清空汇总表内的F:I列数据
- .[F1:I1] = Split("姓名,年龄,籍贯,区域", ",") '通过以逗号为拆分词来拆分字符串所得数组赋值给F1:I1单元格作为标题
- If nFill > 0 Then '假如查询数据数组的记录行数大于0,即表示有数据
- .[F2].Resize(nFill, 4) = Application.WorksheetFunction.Transpose(vFill)
- '因为前面定义vFill时按(列,行)定义的,需要通过系统的转置函数Transpose转置为(行,列)数组
- '赋值给由F2开始变形为nFill行,4列的单元格区域
- End If
- End With '结束对”汇总“表进行操作
- Application.ScreenUpdating = True
- End Sub
复制代码
|
评分
-
3
查看全部评分
-
|