VBA 批量处理Excel文件

ops/2024/9/23 13:00:20/

目录

  • 一. 批量创建Excel文件
    • 1.1 VBA的方式
    • 1.2 Powershell方式
  • 二. 批量删除文件
  • 三. 批量重命名文件
  • 四. 合并多个Excel数据到一个Excel文件中


一. 批量创建Excel文件

VBA_4">1.1 VBA的方式

Sub CreateFiles()Dim strPath As String, strFileName As StringDim i As Long, rDim pathSeparator As StringOn Error Resume Next' 用户选择文件夹路径With Application.FileDialog(msoFileDialogFolderPicker)' 如果用户未选择文件夹则退出程序If .Show ThenstrPath = .SelectedItems(1)ElseExit SubEnd IfEnd With' 给路径添加分隔符pathSeparator = Application.pathSeparatorIf Right(strPath, 1) <> pathSeparator ThenstrPath = strPath & pathSeparatorEnd If' 取消屏幕刷新Application.ScreenUpdating = False' 取消警告提示,当有重名工作簿时直接覆盖Application.DisplayAlerts = False' 数据装入数组rr = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)' 标题不要,因此从第2个元素开始遍历数组rFor i = 2 To UBound(r)' 新建工作簿With Workbooks.Add' 以指定名称、默认文件类型保存工作簿.SaveAs strPath & r(i, 1), xlWorkbookDefault' 关闭工作簿.Close TrueEnd WithNextApplication.ScreenUpdating = TrueApplication.DisplayAlerts = TrueMsgBox "Excel批量创建完成。"
End Sub

1.2 Powershell方式

# 指定要创建的文件数量
$excelCount = 5
# 指定文件名前缀
$fileNamePrefix = "Excel文件"# 循环创建指定数量的 Excel 文件
1..$excelCount | ForEach-Object {# 设置文件名,这里使用 .xlsx 格式$fileName = "${fileNamePrefix}_$_.xlsx" # 获取文件路径$filePath = Join-Path -Path $PWD -ChildPath $fileName  # 创建 Excel 工作簿并保存$excel = New-Object -ComObject Excel.Application$workbook = $excel.Workbooks.Add()$workbook.SaveAs($filePath)$workbook.Close()$excel.Quit()<#用来显式释放 Excel COM 对象的资源,以确保在脚本执行完成后,释放 Excel 进程和相关资源,避免资源泄漏和占用问题。使用 Out-Null 可以将输出结果丢弃,避免将释放对象的消息输出到控制台。#>[System.Runtime.Interopservices.Marshal]::ReleaseComObject($excel) | Out-NullWrite-Host "文件: ${fileName} ===> 创建完成!"  # 输出已创建的文件名
}

二. 批量删除文件

⏹获取指定文件夹下的文件

  • Range("A:B").Clear: k = 1
    • ::冒号在 VBA 中用来分隔两条语句,表示同时执行两个操作。
  • strFileName = Dir
    • 获取下一个文件的文件名,通过这个操作,实现了遍历文件夹中的所有文件。
Sub GetFiles()Dim strPath As StringDim strFileName As String, k As LongWith Application.FileDialog(msoFileDialogFolderPicker)' 获取用户选择的文件夹的路径,如果未选取,则退出程序If .Show Then strPath = .SelectedItems(1)ElseExit SubEnd IfEnd WithApplication.ScreenUpdating = FalseIf Right(strPath, 1) <> "\" Then strPath = strPath & "\"End If' 清除A:B列的所有数据Range("A:B").Clear: k = 1' 向A1,B1列填入数据Cells(1, 1) = "旧文件名": Cells(1, 2) = "是否删除"' 获取指定路径下的文件(通配符获取首个文件名)strFileName = Dir(strPath & "*.xls*")Do While strFileName <> ""k = k + 1Cells(k, 1) = strPath & strFileName' 第2次调用Dir函数,未使用任何参数,则获取同目录下的下一个文件名strFileName = DirLoopApplication.DisplayAlerts = TrueEnd Sub

⏹删除文件

  • Set dataRange = Range("A1").CurrentRegion
    • 用于获取指定单元格的当前区域的语法。
    • 返回一个表示当前区域的 Range 对象,该区域是从指定单元格开始向右和向下延伸到包含数据的边界。
    • 在此案例中,数据结构如下
    [["旧文件名", "是否删除"],["文件路径1", "删除"],["文件路径2", "删除"]......
    ]
    
  • Dir(dataRange(i, 1)) <> ""
    • Dir 是一个 VBA 中用于操作文件系统的函数。
    • 主要用于检查文件或目录是否存在,以及获取目录中的文件和子目录列表。
  • Kill dataRange(i, 1)VBA 中用于删除文件或目录的语句。它可以用来删除指定路径下的文件或目录。
Sub DeleteFile()Dim dataRange As RangeDim i As Long' 数据装入数组Set dataRange = Range("A1").CurrentRegion' 标题行不要,从数组第二行开始遍历For i = 2 To dataRange.Rows.Count' 如果第2列为删除,并且要删除的文件存在的话,才会执行删除命令If dataRange(i, 2) = "删除" And Dir(dataRange(i, 1)) <> "" Then' Kill语句删除指定文件Kill dataRange(i, 1)End IfNextMsgBox "批量删除完成!"
End Sub

三. 批量重命名文件

  • Name r(i, 1) As r(i, 2):将A2单元格中的文件,重命名为B2单元格中的文件名
    • VBA 中,Name 关键字用于重命名文件或文件夹。
    • Name "文件绝对路径1" As "文件绝对路径2"
Sub ChangeFileName()Dim r, i As Long' 数据装入数组r = Range("A1").CurrentRegion ' 标题行不要,从数组第二行开始遍历For i = 2 To UBound(r)' Name语句重命名Name r(i, 1) As r(i, 2) NextMsgBox "文件批量重命名完成!"End Sub

四. 合并多个Excel数据到一个Excel文件中

  • Val(InputBox("请输入标题的行数,默认标题行数为1", "提醒", 1))
    • Val函数可以将数字字符串转换为数字
  • With GetObject(strPath & strFileName)
    • 只读形式读取文件时,使用getobject会比workbooks.open稍快
  • Exit Do:跳出本次Do while循环,相当于continue的效果。
  • .Range("A1:B1") = Array("来源工作簿名称", "来源工作表名称"):同时向A1,B1单元格赋值。
  • IIf(nTitleRow = 0, 1, 0)IIf(条件, 真时返回的值, 假时返回的值)
  • InStr(1, shtData.Name, strKey, vbTextCompare):InStr函数,用于在一个字符串中查找另一个字符串,并返回第一个匹配的位置。
    • 1:指定搜索的起始位置,这里是从字符串的第一个字符开始搜索。
    • shtData.Name:待被搜索的字符串。
    • strKey:要查找的子字符串(从shtData.Name中查找strKey)。
    • vbTextCompare:指定比较方式,这里使用文本比较,表示不区分大小写进行比较。
Sub CollectWorkBookDatas()Dim shtActive As Worksheet, rng As Range, shtData As WorksheetDim nTitleRow As Long, k As Long, nLastRow As LongDim i As Long, j As Long, nStartRow As LongDim aData, aResult, nStarRng As LongDim strPath As String, strFileName As StringDim strKey As String, nShtCount As Long' 获取用户选择的文件夹路径With Application.FileDialog(msoFileDialogFolderPicker)If .Show Then strPath = .SelectedItems(1)ElseExit SubEnd IfEnd With' /_/_/_/_/_/_/_/_/获取用户输入的数据Start/_/_/_/_/_/_/_/_/strKey = InputBox("请输入需要合并的工作表所包含的关键词:" & vbCrLf & "如未填写关键词,则默认汇总全部表格数据", "提醒")' 如果点击了取消或者关闭按钮,则退出程序If StrPtr(strKey) = 0 ThenExit SubEnd IfnTitleRow = Val(InputBox("请输入标题的行数,默认标题行数为1", "提醒", 1))If nTitleRow < 0 ThenMsgBox "标题行数不能为负数。", 64, "警告": Exit SubEnd If
' /_/_/_/_/_/_/_/_/获取用户输入的数据End/_/_/_/_/_/_/_/_/Set shtActive = ActiveSheetWith Application' Excel 的屏幕刷新设置为 False' 在执行后续操作时将不会看到屏幕上的更新,可以加快代码执行速度。.ScreenUpdating = False' Excel 的显示警告设置为 False]' 在执行后续操作时将不会显示警告框,比如保存文件时的覆盖提示等。.DisplayAlerts = False' Excel 的更新链接时询问设置为 False' 在打开包含链接的工作簿时将不会询问是否要更新链接。.AskToUpdateLinks = FalseEnd With' 声明结果数组ReDim aResult(1 To 80000, 1 To 1)' 清空当前表格数据Cells.ClearContents ' 设置单元格为文本格式Cells.NumberFormat = "@"' 补全路径If Right(strPath, 1) <> "\" ThenstrPath = strPath & "\"End If' 使用Dir函数遍历excel文件strFileName = Dir(strPath & "*.xls*") Do While strFileName <> ""' 避免同名文件重复打开出错If strFileName = ThisWorkbook.Name Then ' 继续下一个excel文件strFileName = Dir ' 跳出本次While循环Exit Do End If' 以只读形式读取文件时,使用getobject会比workbooks.open稍快With GetObject(strPath & strFileName)' 遍历Excel中的各sheet页For Each shtData In .Worksheets ' 如果表中包含关键字则进行汇总(不区分关键词字母大小写)If InStr(1, shtData.Name, strKey, vbTextCompare) Then' 获取sheet页中的使用区域Set rng = shtData.UsedRange' 判断工作表是否存在数据If rng.Count > 1 Then' 汇总工作表的数量nShtCount = nShtCount + 1 ' 判断遍历数据源是否应该扣掉标题行nStartRow = IIf(nShtCount = 1, 1, nTitleRow + 1)' 数据区域读入数组arraData = rng.Value' 动态调整结果数组brr的最大列数If UBound(aData, 2) + 2 > UBound(aResult, 2) ThenReDim Preserve aResult(1 To UBound(aResult), 1 To UBound(aData, 2) + 2)End If' 遍历行For i = nStartRow To UBound(aData)k = k + 1' 数组第一列放工作簿名称aResult(k, 1) = strFileName' 数组第二列放工作表名称aResult(k, 2) = shtData.Name' 遍历列For j = 1 To UBound(aData, 2)aResult(k, j + 2) = aData(i, j)Next' 如果数据行数到达结果数组的上限,则将数据导入汇总表,并清空结果数组If k > UBound(aResult) - 1 ThenWith shtActive' 获取放置来源数据的位置nLastRow = .Cells(Rows.Count, 1).End(xlUp).Row ' 判断是否扣除标题行If nLastRow = 1 ThennStarRng = IIf(nTitleRow = 0, 1, 0).Range("A1").Offset(nStarRng).Resize(k, UBound(aResult, 2)) = aResult' 前两列放来源工作簿和工作表名称.Range("A1:B1") = Array("来源工作簿名称", "来源工作表名称")Else' 放结果数组的数据.Range("A1").Offset(nLastRow).Resize(k, UBound(aResult, 2)) = aResultEnd IfEnd Withk = 0' 重新设置结果数组ReDim aResult(1 To UBound(aResult), 1 To UBound(aResult, 2))End IfNextEnd IfEnd IfNext.Close False '关闭工作簿End With' 继续下一个excel文件strFileName = DirLoopIf k > 0 Then' 激活汇总表shtActive.Select ' 放置数据的位置nLastRow = Cells(Rows.Count, 1).End(xlUp).Row' 如果汇总表数据为空,说明需要汇总的数据没有超过结果数组的上限If nLastRow = 1 ThennStarRng = IIf(nTitleRow = 0, 1, 0)Range("a1").Offset(nStarRng).Resize(k, UBound(aResult, 2)) = aResultRange("a1:b1") = Array("来源工作簿名称", "来源工作表名称")ElseRange("a1").Offset(nLastRow).Resize(k, UBound(aResult, 2)) = aResultEnd IfEnd If' 更新Excel的设置With Application.ScreenUpdating = True.DisplayAlerts = True.AskToUpdateLinks = TrueEnd WithMsgBox "一共汇总完成。" & nShtCount & "个工作表!", , "提示"End Sub

http://www.ppmy.cn/ops/36546.html

相关文章

Golang Map类型

文章目录 Map介绍Map的定义方式Map的增删查改新增和修改Map元素查找Map元素删除Map元素遍历Map元素 Map元素排序Map切片 Map介绍 Map介绍 在Go中&#xff0c;map是哈希表的引用&#xff0c;是一种key-value数据结构。map类型写作map[K]V&#xff0c;其中K和V分别对应key和value…

[Linux] GDB使用指南----包含CentOS7下安装以及使用

什么是GDB&#xff1f; GDB 是由 GUN 软件系统社区提供的调试工具&#xff0c;同 GCC 配套组成了一套完整的开发环境&#xff0c;GDB 是 Linux 和许多 类Unix系统的标准开发环境。可以用来调试C、C、Go、java、 objective-c、PHP等语言。 GDB的作用 程序启动时&#xff0c;可…

QT之信号和槽

在刚刚了解Qt的时候&#xff0c;为了通过按钮显示 hello world 的时候曾说明过信号与槽&#xff0c;虽然没有细说&#xff0c;不过也算是接触过。 而本文就会细细说明什么是 Qt 的信号与槽。 概念初识 在 linux 学进程相关的内容的时候&#xff0c;曾了解过信号是操作系统控…

HarmonyOS实战开发教程-如何开发一个2048游戏

今天为大家分享的是2048小游戏&#xff0c;先看效果图&#xff1a; 这个项目对于新手友友来说可能有一点难度&#xff0c;但是只要坚持看完一定会有收获。因为小编想分享的并不局限于ArkTs语言&#xff0c;而是编程思想。 这个游戏的基本逻辑是初始化一个4乘4的数组&#xff…

深入理解指针1

目录 如对您有帮助&#xff0c;还望三连支持&#xff0c;谢谢&#xff01;&#xff01;&#xff01; 1.内存和地址 计算机中常⻅的单位&#xff08;补充&#xff09;&#xff1a; 如何理解编址 2.指针变量和地址 2.1取地址操作符&#xff08;&&#xff09; 2.2指针变…

Spring Data JPA数据批量插入、批量更新真的用对了吗

Spring Data JPA系列 1、SpringBoot集成JPA及基本使用 2、Spring Data JPA Criteria查询、部分字段查询 3、Spring Data JPA数据批量插入、批量更新真的用对了吗 4、Spring Data JPA的一对一、LazyInitializationException异常、一对多、多对多操作 前言 在前两篇文章已经…

小红书餐饮推广怎么合作?纯干货

小红书作为国内领先的生活方式分享平台&#xff0c;其用户群体主要集中在一二线城市&#xff0c;年龄分布在18-35岁之间&#xff0c;其中女性用户占比高达80%。这部分用户具有较高的消费能力、审美追求和品质生活需求&#xff0c;对美食有着极高的兴趣和消费意愿&#xff0c;为…

我独自升级崛起游戏账号登录注册教程 (5.8最新版)

新韩漫公司所发布的这项动作游戏已向玩家们敞开大门&#xff0c;为大家带来了前所未有的游戏体验和乐趣。这个游戏内包含了大量令人着迷的故事、令人印象深刻的战斗场景以及丰富多样的娱乐元素。在这其中最为引人注目的一点就是游戏内容中融入了“虚拟角色”的元素&#xff0c;…