【附件】AU3汇总EXCEL表格（带格式不带公式）请教[已解决]-已解决问题区-AUTOIT CN

天芯蓝影 发表于 2012-7-3 09:06:52

【附件】AU3汇总EXCEL表格（带格式不带公式）请教[已解决]

本帖最后由天芯蓝影于 2012-7-5 10:35 编辑

1.复制1~5甚至更多文档中结果统计（可能叫统计，汇总等名字，有多个，但是种类固定）到一个新的SHEET1
2.复制1~5甚至更多文档中列表（可能叫问题列表，列表目录，有多个，但是种类固定）到一个新的SHEET2
3.以上复制中复制格式，颜色，列宽等属性，仅复制公式计算出的值（不复制公式），见理想效果图

难点：要把需要的内容复制，但是不复制公式，要复制格式，有合并单元格，需要判断行末尾等等

说下今天尝试了一天的研究结果，如果没有合并单元格和公式，逐行读取写入就可以实现
有了合并单元格之后，上面的方法很大概率出错，另外碰到过几次，复制到第2，第3个文件中的合并单元格出错，之前的是可以的
寻求讨论共同解决问题，谢谢

另外用VBA试了下，也没有简单的实现方法，实在不行可能就只有用VBA先把需要的SHEET复制到一个工作表中，然后合并不带格式再设置格式了

这样写的程序相对较死板，很难通用了

netegg 发表于 2012-7-3 09:16:04

同一工作簿中的不同工作表的格式本来就是独立定制的

kevinch 发表于 2012-7-3 09:49:25

看不懂，不过楼主提供的表格我们一般称之为看的表格，对于数据处理，这类表格让事情变得复杂，方便数据处理的表格只能是行列形式的二维表格，不要有合并单元格，只要源数据是易于处理的格式，对于实现想看的表格都是方便用程序处理出来的，而当源数据都是方便看的表格时，困难^2

天芯蓝影 发表于 2012-7-3 14:48:43

用VBA算是勉强实现了，后续有时间再优化吧Sub 汇总数据()
Sheets.Add
With ActiveSheet
   .Name = "汇总表" & Format(Now, "hhmmss")
   For Each s In ThisWorkbook.Sheets
         s.UsedRange.Copy .Cells(.UsedRange.Rows.Count + 1, 1)
   Next
End With
End SubSub 合并EXCEL文件()
ActiveWorkbook.Save '先保存目标文件
Dim FilesToOpen '缺省情况被声明为 Variant
Dim X As Integer
Dim I As Integer
Dim Mname As String
Dim Oname As String
Dim Keyn As String
On Error GoTo ErrHandler
Application.ScreenUpdating = False

Mname = ActiveWorkbook.Name '目标文件名
FilesToOpen = Application.GetOpenFilename(FileFilter:="MicroSoft Excel文件(*.xls),*.xls", Title:="", MultiSelect:=True)

If TypeName(FilesToOpen) = "Boolean" Then
   MsgBox "没有选中文件"
   GoTo ExitHandler
End If

Keyn = InputBox("请输入需要合并的工作表名(包含关键字)" & _
   Chr(10) & "后续所选文件的全部工作表导入,直接按确定或取消") ', , ActiveSheet.name)

X = 1
While X <= UBound(FilesToOpen)
   Workbooks.Open Filename:=FilesToOpen(X)
   With ActiveWorkbook
         Oname = .Name '源文件名
         For I = 1 To .Sheets.Count
            If InStr(Sheets(I).Name, Keyn) Then '如果Keyn为空则全部复制

               .Sheets(I).Copy after:=Workbooks(Mname).Sheets(Workbooks(Mname).Sheets.Count) '复制到目标文件的最后一张表
               Workbooks(Mname).Sheets(Workbooks(Mname).Sheets.Count).Name = Replace(Oname, ".xls", "-") & .Sheets(I).Name '重命名
            End If
         Next I
         .Close '源文件关闭
         X = X + 1
   End With
Wend
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub

天芯蓝影 发表于 2012-7-3 14:50:05

先把需要汇总的都整到一个EXCEL中，然后再合并一下

天芯蓝影 发表于 2012-7-5 10:36:00

用VBA代码解决了这个问题，结贴

分三步走
1.汇总目录下所有需要的工作表
2.汇总当前EXCEL下刚才收集到的工作表
3.删除汇总的多个工作表，保留总表

页: [1]

AUTOIT CN's Archiver

【附件】AU3汇总EXCEL表格（带格式不带公式）请教[已解决]