一. 批量创建Excel文件
1.1 VBA的方式
Sub CreateFiles()
Dim strPath As String, strFileName As String
Dim i As Long, r
Dim pathSeparator As String
On Error Resume Next
' 用户选择文件夹路径
With Application.FileDialog(msoFileDialogFolderPicker)
' 如果用户未选择文件夹则退出程序
If .Show Then
strPath = .SelectedItems(1)
Else
Exit Sub
End If
End With
' 给路径添加分隔符
pathSeparator = Application.pathSeparator
If Right(strPath, 1) <> pathSeparator Then
strPath = strPath & pathSeparator
End If
' 取消屏幕刷新
Application.ScreenUpdating = False
' 取消警告提示，当有重名工作簿时直接覆盖
Application.DisplayAlerts = False
' 数据装入数组r
r = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
' 标题不要，因此从第2个元素开始遍历数组r
For i = 2 To UBound(r)
' 新建工作簿
With Workbooks.Add
' 以指定名称、默认文件类型保存工作簿
.SaveAs strPath & r(i, 1), xlWorkbookDefault
' 关闭工作簿
.Close True
End With
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "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-Null
Write-Host "文件: ${fileName} ===> 创建完成!" # 输出已创建的文件名
}
二. 批量删除文件
⏹获取指定文件夹下的文件
Range("A:B").Clear: k = 1:：冒号在 VBA 中用来分隔两条语句，表示同时执行两个操作。
strFileName = Dir- 获取下一个文件的文件名，通过这个操作，实现了遍历文件夹中的所有文件。
Sub GetFiles()
Dim strPath As String
Dim strFileName As String, k As Long
With Application.FileDialog(msoFileDialogFolderPicker)
' 获取用户选择的文件夹的路径，如果未选取，则退出程序
If .Show Then
strPath = .SelectedItems(1)
Else
Exit Sub
End If
End With
Application.ScreenUpdating = False
If 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 + 1
Cells(k, 1) = strPath & strFileName
' 第2次调用Dir函数，未使用任何参数，则获取同目录下的下一个文件名
strFileName = Dir
Loop
Application.DisplayAlerts = True
End 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 Range
Dim 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 If
Next
MsgBox "批量删除完成!"
End Sub
三. 批量重命名文件
Name r(i, 1) As r(i, 2):将A2单元格中的文件，重命名为B2单元格中的文件名- 在 VBA 中，
Name关键字用于重命名文件或文件夹。 Name "文件绝对路径1" As "文件绝对路径2"
- 在 VBA 中，
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)
Next
MsgBox "文件批量重命名完成!"
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 Worksheet
Dim nTitleRow As Long, k As Long, nLastRow As Long
Dim i As Long, j As Long, nStartRow As Long
Dim aData, aResult, nStarRng As Long
Dim strPath As String, strFileName As String
Dim strKey As String, nShtCount As Long
' 获取用户选择的文件夹路径
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then
strPath = .SelectedItems(1)
Else
Exit Sub
End If
End With
' /_/_/_/_/_/_/_/_/获取用户输入的数据Start/_/_/_/_/_/_/_/_/
strKey = InputBox("请输入需要合并的工作表所包含的关键词：" & vbCrLf & "如未填写关键词，则默认汇总全部表格数据", "提醒")
' 如果点击了取消或者关闭按钮，则退出程序
If StrPtr(strKey) = 0 Then
Exit Sub
End If
nTitleRow = Val(InputBox("请输入标题的行数，默认标题行数为1", "提醒", 1))
If nTitleRow < 0 Then
MsgBox "标题行数不能为负数。", 64, "警告": Exit Sub
End If
' /_/_/_/_/_/_/_/_/获取用户输入的数据End/_/_/_/_/_/_/_/_/
Set shtActive = ActiveSheet
With Application
' Excel 的屏幕刷新设置为 False
' 在执行后续操作时将不会看到屏幕上的更新，可以加快代码执行速度。
.ScreenUpdating = False
' Excel 的显示警告设置为 False]
' 在执行后续操作时将不会显示警告框，比如保存文件时的覆盖提示等。
.DisplayAlerts = False
' Excel 的更新链接时询问设置为 False
' 在打开包含链接的工作簿时将不会询问是否要更新链接。
.AskToUpdateLinks = False
End With
' 声明结果数组
ReDim aResult(1 To 80000, 1 To 1)
' 清空当前表格数据
Cells.ClearContents
' 设置单元格为文本格式
Cells.NumberFormat = "@"
' 补全路径
If Right(strPath, 1) <> "\" Then
strPath = 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)
' 数据区域读入数组arr
aData = rng.Value
' 动态调整结果数组brr的最大列数
If UBound(aData, 2) + 2 > UBound(aResult, 2) Then
ReDim 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 Then
With shtActive
' 获取放置来源数据的位置
nLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
' 判断是否扣除标题行
If nLastRow = 1 Then
nStarRng = 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)) = aResult
End If
End With
k = 0
' 重新设置结果数组
ReDim aResult(1 To UBound(aResult), 1 To UBound(aResult, 2))
End If
Next
End If
End If
Next
.Close False '关闭工作簿
End With
' 继续下一个excel文件
strFileName = Dir
Loop
If k > 0 Then
' 激活汇总表
shtActive.Select
' 放置数据的位置
nLastRow = Cells(Rows.Count, 1).End(xlUp).Row
' 如果汇总表数据为空，说明需要汇总的数据没有超过结果数组的上限
If nLastRow = 1 Then
nStarRng = 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)) = aResult
End If
End If
' 更新Excel的设置
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.AskToUpdateLinks = True
End With
MsgBox "一共汇总完成。" & nShtCount & "个工作表!", , "提示"
End Sub