037-多表汇总至总表-疑难千寻千解丛书（VBA）

小妖

ET疑难千寻千解丛书之EXCEL2010编程与实践

罗刚君 章兰新 黄朝阳 编著

疑难37
如何将所有表中查找的完成数汇总到总表

如图所示包括多个组别的目标产量与实际产量，如何实现将所有组别中完成目标者汇总到总表中?

è 解决方案

利用循环对“总表”以外的每个工作表进行数据查找。查找前，在D列创建一个辅助区，利用公式“=IF(B2-C2=0,0/0,"")”将所有完成目标者标识一个错误值，再利用SpecialCells方法定位所有错误值所在行，并复制到“总表”中，最后清除所有辅助区。

í 操作方法

步骤1
按【Alt+F11】组合键打开VBE窗口。

步骤2
选择菜单“插入”→“模块”，并输入以下代码：

1. 
   
2. Sub 多表查找并汇总()
   
3.   Dim sht As Worksheet, arr(), i As Integer
   
4.   On Error Resume Next '验证是否存在“总表”
   
5.   Set sht = Sheets("总表")
   
6.   If Err <> 0 Then  '如果不存在“总表”则在最末处添加一个总表
   
7. Sheets.Add , after:=Sheets(Sheets.Count)
   
8. Sheets(Sheets.Count).Name = "总表"
   
9.   Else  '否则清除总表的所有数据
   
10.     sht.Cells.Clear
    
11.   End If
    
12.   Sheets(1).Rows(1).Copy sht.[a1]  '将标题行复制到总表
    
13.   For Each sht In Sheets  '遍历所有工作表
    
14.     If sht.Name <> "总表" Then  '仅对总表以外的表进行操作
    
15.       With sht.Range(sht.[D2], sht.Cells(Rows.Count, 3).End(xlUp).Offset
    
16.       (0, 1))  '建立辅助区
    
17.         .FormulaR1C1 = "=IF(RC[-2]-RC[-1]=0,0/0,"""")"
    
18.         '在辅助区设置公式，当完成值等于目标值时公式返回错误
    
19.         '定位D列所有错误单元格（即已完成的），并将整行复制到总表中第一个空行
    
20.         .SpecialCells(xlCellTypeFormulas, 16).EntireRow.Copy Sheets("总表
    
21.         ").Cells(Sheets("总表").Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
    
22.         .Clear  '清除辅助区
    
23.       End With
    
24.     End If
    
25.   Next
    
26.   Sheets("总表").Columns(4).Clear  '清除公式所在列
    
27. End Sub
    

复制代码

步骤3
光标置于代码中任意位置，并按【F5】键执行，程序将对每个表中已完成者信息合并到“总表”中，如图所示。

=============================

以上摘自《EXCEL2010编程与实践》

hai

學習了，妖好厲害！

张啸宁

很难，我不会，一看就头疼。问题是，我想学会，请问小妖老师，该从何学起？

fulljy

学习了，谢谢!