Office中国论坛/Access中国论坛

标题: 灵活的多工作表合并或汇总 [打印本页]
作者: wenwen000424    时间: 2009-1-20 18:32
标题: 灵活的多工作表合并或汇总
搜索了论坛，有很多关于工作表合并汇总的帖子，总感觉缺乏灵活性和通用性。现有一种思路请求高手帮助实现。先行谢过！
作者: pureshadow    时间: 2009-1-20 18:46
用合并计算吧，这是技巧操作里比较简单的一种。
不过，楼主，要分那么多工作表不如直接做在一个工作表里，你每个表的数据量又不大，分开来又浪费资源，又不方便统计，不是很麻烦么？

如果你一定要最灵活通用的办法，那只有用代码，下面这段你参考一下吧：

Sub test江羽解释师傅版()
    Dim i As Long
    Dim rngTitle As Range
    Dim vData As Variant
    Dim lEndRow As Long
   
    '删除"combine"表单元格内容,Delete有几个常量,表示位移方式
    Sheets("combine").Cells.Delete
   
    '循环所有表
    For i = 1 To Sheets.Count
        
        '对遍历的所有表进行如下操作
        With Sheets(i)
            
            '避开"combine"表
            If .Name <> Sheets("combine").Name Then
               
                '判断是否赋值
                If rngTitle Is Nothing Then
                    
                    '对自定义变量进行赋值,为当前表的A1到L2区域, _
                     这是预留两行标题行,因前题是所有表的表格标题行都是一样的, _
                     所以只复制第一个表的标题行到"combine"表中就可以了
                    Set rngTitle = .Range("A1:L2")
                    
                    '将当前表的A1到L2区域,即标题行复制到"combine"表, _
                    选定"combine"表的A1单元格进行复制
                    rngTitle.Copy Sheets("combine").[a1]
                End If
               
                '向变量lEndRow进行赋值,该值为当前表的B4单元格所选区域向移动到末端单元格的行
                lEndRow = .[B4].End(xlDown).Row
               
                '向变量vData赋值,该值为B4到当前表中所有数据最后所在行与12列的交差点的区域
                vData = .Range(.Cells(4, 2), .Cells(lEndRow, 12))
               
                '重新调整"combine"表区域,将其调整与vData相同,并该区域值复制数据
                With Sheets("combine")
                    .Cells(.[B65536].End(xlUp).Row + 1, 2).Resize(UBound(vData), 11) = vData
                End With
            End If
        
        End With
    Next
   
   
    '该段代码是向"combine"表的第一列中添加自然编码
    With Sheets("combine")
        '从表格最底端向上移动行,并赋值给变量
        lEndRow = .[B65536].End(xlUp).Row
        '表格A3到A4区域输入数组
        .Range("A3:A4") = Application.Transpose(Array(1, 2))
        '选中A3至A4仿拖拉填充,相当于选中A3至A4单元格向下复制,达到自动填充序号的目的
        .Range("A3:A4").AutoFill .Range("A3:A" & lEndRow)
    End With
End Sub

[ 本帖最后由 pureshadow 于 2009-1-20 18:47 编辑 ]
作者: wenwen000424    时间: 2009-1-20 19:44
谢谢你的积极帮助，我上传的附件只是一个样本而已，数据和工作表个数都是可以变化的。求通用的代码。用你提供的代码出现下标越界错误，你能否用我提供的附件做一个传上来。
作者: pureshadow    时间: 2009-1-20 22:54
下标越界应该是工作表名不一致造成的，这段代码是我师傅写的，可惜我是V白，被江版注解过了里面有些地方仍不是太明白。
作者: wenwen000424    时间: 2009-1-21 07:24
谢谢,只好继续期待.
作者: wenwen000424    时间: 2009-1-23 10:37
快过春节了,都忙着办年货去啦?没有人帮助解决,呜.....。无论如何，还是得先给大家拜个早年，祝大家新春快乐，牛年吉祥！
作者: fox_liena    时间: 2009-4-22 09:17
拿来看看!
作者: 阳光心情    时间: 2009-5-26 00:35
不懂,学习中.亦是相关问题.



欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3