登陆
最新消息: 网站开启https访问,有证书更安全!


EXCEL-VBA常用小代码:一键汇总各分表数据到总表

技巧资料 骑猪看月亮 3728次浏览 暂无评论

今天和大家分享的是VBA常用小代码系列第五篇:一键汇总各分表数据到总表。

照例举个栗子,如下图,一个工作簿,包含多个工作表,现在需要将各个分表的数据汇总到总表中…

0.gif

碰到这样的问题,有些小伙伴会想到使用数据透视表或者合并计算等方式进行操作。

但这两种操作方式都有它的局限性。

比如说,它们是统计汇总数据而不是收集明细记录;另外,当标题行或列是多行(多列),甚至存在合并单元格时,它们也就无能无力了。

等等。

代码一两行,工作不用愁断肠。面对这样的情况,VBA小代码解决方案如下:

Sub collect()
    'VBA编程学习与实践,一键多表数据汇总~看见星光
    Dim sht As Worksheet, rng As Range, k&, trow&
    Application.ScreenUpdating = False
    '取消屏幕更新,加快代码运行速度
    trow = Val(InputBox("请输入标题的行数", "提醒"))
    If trow < 0 Then MsgBox "标题行数不能为负数。", 64, "警告": Exit Sub
    '取得用户输入的标题行数,如果为负数,退出程序
    Cells.ClearContents
    '清空当前表数据
    Cells.NumberFormat = "@"
    '设置文本格式
    For Each sht In Worksheets
    '遍历表格
        If sht.Name <> ActiveSheet.Name Then
        '如果表格名称不等于当前表名则进行复制数据……
            Set rng = sht.UsedRange
            '定义rng为表格已用区域
            k = k + 1
            '累计K值
            If k = 1 Then
            '如果是首个表格,则K为1,则把标题行一起复制到汇总表
                rng.Copy
                [a1].PasteSpecial Paste:=xlPasteValues
            Else
                '否则,扣除标题行后再复制黏贴到总表,只黏贴数值
                rng.Offset(trow).Copy
                Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1).PasteSpecial Paste:=xlPasteValues
            End If
        End If
    Next
    [a1].Activate
    '激活A1单元格
    Application.ScreenUpdating = True
    '恢复屏幕刷新
End Sub
囧 亲 晕 酷 哭 馋 闭嘴 调皮 贪 奸 怒 嘿 羞 汗 色 惊 萌 悲 笑 惊 狂 吃
囧 亲 晕 酷 哭 馋 闭嘴 调皮 贪 奸 怒 嘿 羞 汗 色 惊 萌 悲 笑 惊 狂 吃

Hi,您需要填写昵称和邮箱!

  • 昵称 (必填)
  • 邮箱 (必填)
  • 网址