excel宏，如何将数百个工作簿的中指定数据汇总到一个新工作簿的新工作表。请高手指教
excel宏，如何将数百个工作簿的中指定数据汇总到一个新工作簿的新工作表。请高手指教
悬赏分：20 - 解决时间：2009-5-2 14:20
数百个工作簿中每个工作簿的数据全部都在A1:E3000,格式都一样
数百个工作簿中每个工作簿都存放在gupiao文件夹里，路径为c:\gupiao
文件内容为：
a1列(前面空格18） 日期 名称 代码
20090414 智光电气 (002169)
A4列——B4列——C4列——D4列——E4列
时间——价格——现量——笔数——S\B
9:25——5.92——11———5————B
9:30——5.91——12———2————S
9:30——5.95——103——10————B
9:31——5.85——3———64————S
9:31——5.85——2———18————S
9:32——5.81——50———2————S
9:32——5.87——53———9————B
结果要求为
获取文件内相关内容后，结果为：
A列－－日期
B列－－名称
C列－－代码
D列－－b列最大值对应c列的和
E列－－b列最大值对应c列的和占c列总数的百分之几
F列－－e列的“b”对应c列的和
G列－－e列的“s”对应c列的和
H列－－e列的“b”对应c列的和（减去）e列的“s”对应c列的和
I列－－e列的“b”对应c列与b列的积的和
J列－－e列的“s”对应c列与b列的积的和
K列－－e列的“b”对应c列与b列的积的和（减去）e列的“s”对应c列与b列的积的和
L列－－e列的“b”对应c列与b列的积的和（除以）e列的“s”对应c列与b列的积的和
M列－－b列第一个最大值对应的A列的值
N列－－b列最后一个最大值对应的A列的值
a－－－－－－－－－b－－－－c－－－d－－－e－－－f－－－g－
20090414－ 智光电气－002169－103－44％－167－67－
－h－－－i－－－－－j－－－－－k－－－－－－－l－－－－－
100－989.08－129.67－859.41－762.76％－
－m－－－－－n－－
9：30－－9：30
-----
a－－－－－-b－－－－－c－－－-d－－-e－－－f－－
20090414－ 智光电气－002169－103－44％－167－67－
-g－－h－－－i－－－j－－－－k－ －l－－－－m－
100－989.08－129.67－859.41 -762.76％－9：30－
－－－n－－
－9：30
'功能：合并某文件下所有Excel工作簿中的第一个工作表
'使用：将要合并的工作簿拷贝到某文件夹下，新建一个工作簿后执行该宏
Dim WBName As String '汇总工作簿名称
Dim WBCurrent As String '当前正在合并的工作簿
Dim i As Integer
Dim FileToOpen As Variant '选定的文件列表
'显示选择文件对话框，使用Ctrl或Shief键选取多个工作簿
FileToOpen = Application _
.GetOpenFilename("Excel Files (*.xls), *.xls", , "请选择要合并的工作簿", , True)
'如果没有选择文件则退出
If IsArray(FileToOpen) = 0 Then
MsgBox "没有选择文件"
Exit Sub
End If
'不显示合并的过程
Application.ScreenUpdating = False
WBName = ActiveWorkbook.Name
'逐个合并工作簿
For i = 1 To UBound(FileToOpen)
'打开一个工作簿
Workbooks.Open Filename:=FileToOpen(i)
WBCurrent = ActiveWorkbook.Name
'将该工作簿复制到汇总工作簿
Sheets("sheet1").Copy Before:=Workbooks(WBName).Sheets(1)
'将去掉".xls"后缀的工作簿文件名作为工作表名称，
ActiveSheet.Name = Left(WBCurrent, Len(WBCurrent) - 4)
'合并后关闭该工作簿
Workbooks(WBCurrent).Close
Next i
Application.ScreenUpdating = True
End Sub
Sub 汇总工作簿()
'功能: 对工作簿中所有工作表选定的区域汇总求和
'使用: 在任一工作表选定需要添加汇总公式的区域后执行该宏
'可以使用 Ctrl和Shief键进行选取，然后执行该宏
Dim RangA As Range '选定区域
Dim c As Range
Dim CellAddress As String '选定区域每个单元格的地址
Set RangA = Selection
'插入一个与现有工作表一样的工作表
Sheets(1).Copy Before:=Sheets(1)
'ActiveSheet.Name = "汇总" 可以根据需要将该工作表命名为”汇总”
For Each c In RangA
'取每个单元格的相对地址
CellAddress = c.Address(RowAbsolute:=False, _
ColumnAbsolute:=False)
'为单元格设置求和公式
Sheets(1).Range(c.Address).Formula = "=sum('" + Sheets(2).Name + ":" _
+ Sheets(Sheets.Count).Name + "'!" + CellAddress + ")"
Next c
End Sub
