• vba合并报表(搬一下)


     1 '******
     2 '函数作用:将该文件夹下所有工作簿的工作表合并到该文件的单一工作表,包括后缀是xls、xlsx、xlsm等的所有文件。
     3 '******
     4 'Option Explicit 语句在模块级别中使用,强制显示声明模块中的所有变量。Option Explicit 语句必须写在模块的所有过程之前。
     5 '如果模块中使用了 Option Explicit,则必须使用 Dim、Private、Public、ReDim 或 Static 语句来显式声明所有的变量。
     6 '如果使用了未声明的变量名在编译时会出现错误。
     7 '如果没有使用 Option Explicit 语句,除非使用 Deftype 语句指定了缺省类型,否则所有未声明的变量都是 Variant 类型的。
     8 '注意:使用 Option Explicit 可以避免键入已有变量时拼错,
     9 '在变量的范围不是很清楚的代码中使用该语句可以避免混乱。
    10 '编译器的默认设置将是 Option Explicit On。
    11 Option Explicit '所有变量必须先定义后使用
    12 Sub 该文件夹下所有工作簿的工作表合并到该文件的单一工作表()
    13 Dim MyPath$, MyName$, sh As Worksheet, sht As Worksheet, m&, IsSheetEmpty As Boolean
    14 Set sh = ActiveSheet
    15 MyPath = ThisWorkbook.Path & ""
    16 MyName = Dir(MyPath & "*.xls")
    17 Application.ScreenUpdating = False
    18 Cells.ClearContents
    19 Do While MyName <> "" ' 如果_pathname_找不到,将返回零长度字符串 ("") 。
    20 'https://docs.microsoft.com/zh-cn/office/vba/language/reference/user-interface-help/dir-function
    21     If MyName <> ThisWorkbook.Name Then '不统计含有该VBA程序的excel文件
    22         With GetObject(MyPath & MyName)
    23         For Each sht In .Sheets
    24           If IsSheetEmpty = IsEmpty(sht.UsedRange) Then '如果sht.UsedRange是空的,则IsEmpty返回True
    25              m = m + 1
    26              If m = 1 Then
    27                 sht.[a1].CurrentRegion.Copy sh.[a1]
    28              Else
    29                 sht.[a1].CurrentRegion.Offset(0).Copy sh.[a65536].End(xlUp).Offset(1)
    30              End If
    31           End If
    32         Next
    33         .Close False
    34         End With
    35     End If
    36     MyName = Dir
    37   Loop
    38 Application.ScreenUpdating = True
    39 MsgBox "已完成 该文件夹下所有工作簿的工作表合并到该文件的单一工作表。"
    40 End Sub

    代码来源于:https://www.jianshu.com/p/28f4555d1053

  • 相关阅读:
    Centos7 安装配置Elasticsearch
    单例模式
    Eclipse上部署maven项目
    单点登录
    各eclipse插件的作用
    eclipse中安装Subclipse插件
    往idea中导入已有的web项目
    maven 项目部署
    【转帖】算法刷题网站
    混淆矩阵-MATLAB代码详解
  • 原文地址:https://www.cnblogs.com/xurui89/p/12556779.html
Copyright © 2020-2023  润新知