设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 3213|回复: 5
打印 上一主题 下一主题

[基础应用] 请教工作薄中一百多个表合并的问题

[复制链接]
跳转到指定楼层
1#
发表于 2008-12-12 16:59:01 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
各位请教.一个工作薄中几十个表头相同的工作表,每个工作表名不一样.我把想它们合并在一个新的工作表中.以便数据的汇总和查询.

请教一;如何把几十个工作表名不一样.但表头一样的数据合为一个明细汇总.
请教二.按每个工作表中的汇总也体现在合并的表中如何操作.
请各位指点.给我一个宏或VB程序能速度组合.因表格太多.谢谢
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅

点击这里给我发消息

2#
发表于 2008-12-12 23:24:43 | 只看该作者
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
3#
 楼主| 发表于 2008-12-13 07:46:06 | 只看该作者
还请告诉我.怎么把这样代码拷入到EXCL里面.如何执行,.谢谢
4#
发表于 2008-12-13 10:00:03 | 只看该作者
好东西要大家分享[:29]

点击这里给我发消息

5#
发表于 2008-12-13 16:43:58 | 只看该作者
alt+f11,然后插入模块,把那个放到模块里。
还有个函数的,不过好像只能在2007版里用:
=INDIRECT("sheet"&SMALL(IF(ROW(INDIRECT("1:"&SUM(SUBTOTAL(3,INDIRECT("sheet"&COLUMN($A:$E)&"!a:a")))))<=SUBTOTAL(3,INDIRECT("sheet"&COLUMN($A:$E)&"!a:a"))-1,COLUMN($A:$E)),(ROW(A1)))&"!r"&MOD(SMALL(IF(ROW($1:$67)<=SUBTOTAL(3,INDIRECT("sheet"&COLUMN($A:$E)&"!a:a"))-1,COLUMN($A:$E)/1%+ROW($1:$67)),ROW(A1)),100)+1&"c"&COLUMN(A1),)
CTRL+SHIFT+ENTER结束,下拉右拉
这是用于五个工作表合并的,如果是100个,其中的$A:$E就要改成$A:$CV
还有就是工作表名是默认的SHEET1、SHEET2……这样的

[ 本帖最后由 pureshadow 于 2008-12-13 16:48 编辑 ]

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
6#
发表于 2008-12-14 06:59:29 | 只看该作者
该妖是好妖
妖精思维
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-5-2 05:07 , Processed in 0.099820 second(s), 30 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表