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


EXCEL-VBA常用小代码:按指定条件汇总各分表数据到总表

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

有朋友问,能不能别一锅端,别把所有的分表数据都汇总了,能不能按指定条件汇总,比如说,只汇总名称里包含某个关键词的工作表?

当然……可以的。

今就把之前那期的代码稍加修改,增加了需要汇总的表格名称关键词输入框。

动画操作:

0.gif


小贴士:

1,代码运行后,会弹出对话框,提醒用户输入需要汇总分表表名所包含的关键词,关键词可以不填(保持为空),此时将对所有的分表进行汇总。另外关键词不区分字母大小写。

2,该代码是将分表的数据汇总明细到当前工作表,因此在使用时务必先选择汇总表。

3,代码不会清除汇总表的单元格格式,如果汇总后的数据失去了分表的数据格式,可以先对汇总表的单元格格式进行预设。

代码如下:
Sub CollectSheets()
    'ExcelHome VBA编程学习与实践
    Dim sht As Worksheet, rng As Range, k&, trow&,temp
    Application.ScreenUpdating = False
    '取消屏幕更新,加快代码运行速度
    temp = InputBox("请输入需要合并的工作表所包含的关键词:", "提醒")
    If StrPtr(temp) = 0 Then Exit Sub
    '如果点击了inputbox的取消或者关闭按钮,则退出程序
    trow = Val(InputBox("请输入标题的行数", "提醒"))
    If trow < 0 Then MsgBox "标题行数不能为负数。", 64, "警告": Exit Sub
    '取得用户输入的标题行数,如果为负数,退出程序
    Cells.ClearContents
    '清空当前表数据
    For Each sht In Worksheets
    '循环读取表格
        If sht.Name <> ActiveSheet.Name Then
        '如果表格名称不等于当前表名则……
            If InStr(1, sht.Name, temp, vbTextCompare) 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
        End If
    Next
    [a1].Activate
    '激活A1单元格
    Application.ScreenUpdating = True
    '恢复屏幕刷新
End Sub


囧 亲 晕 酷 哭 馋 闭嘴 调皮 贪 奸 怒 嘿 羞 汗 色 惊 萌 悲 笑 惊 狂 吃
囧 亲 晕 酷 哭 馋 闭嘴 调皮 贪 奸 怒 嘿 羞 汗 色 惊 萌 悲 笑 惊 狂 吃

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

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