录制宏+循环（批量修改excel文件样式） |
|
作者：
来源：原创
|
现有2个原始文件夹，合计文件60个excel文件，需要对这60个文件，统计进行排版。
处理方案，先把开2个文件，1个为带排好版的模板的文件，另外1个为原始文件，通过把原始文件复制到模板的原始表中进行覆盖，再另存为的操作，达到1个循环完成的过程。
VBA录制宏内容如下：
Sub Macro1()
'
' Macro1 Macro
' 宏由 Administrator 录制，时间: 2023/05/17
'
'
Workbooks.Open Filename:="C:\Users\Administrator\Desktop\库热力入库单\2023年入库单\01.xls", AddToMru:=True
Workbooks.Open Filename:="C:\Users\Administrator\Desktop\库热力入库单\2023年入库单\入库单1.02.xls", AddToMru:=True
Columns("A:U").Select
Selection.Copy
Windows("01.xls").Activate
Sheets("S_KFGL_RKD").Activate
Columns("A:A").Select
ActiveSheet.Paste
Workbooks("入库单1.02.xls").Activate
Application.CutCopyMode = False
ActiveWorkbook.Close
Windows("01.xls").Activate
Application.DisplayAlerts = False
Application.DisplayAlerts = True
Sheets("S_KFGL_RKD (2)").Activate
Application.RecentFiles.Add Name:="C:\Users\Administrator\Desktop\库热力入库单\2023年入库单\入库单1.02.xls"
ActiveWorkbook.SaveAs Filename:="C:\Users\Administrator\Desktop\库热力入库单\2023年入库单\入库单1.02.xls", FileFormat:=xlWorkbookNormal, AccessMode:=xlNoChange, ConflictResolution:=1, AddToMru:=-1
End Sub
|
vba先使用directroy函数获取某个文件夹下的文件名，并赋值给一个数组，使用数组的原因是，调取原excel文件名速度会更快，也更方便。
这个快和方便，是和文件的名称存到excel表格中的单元格相比较而言的。
获得文件名的代码如下：
Sub copypaste()
Dim dir1 As String
path1 = "C:\Users\Administrator\Desktop\库热力入库单\2022年6月至12月入库单\"
dir1 = Dir(path1)
Dim i As Integer
Dim arr1(1 To 100)
i = 1
Do While dir1 <> ""
arr1(i) = dir1
dir1 = Dir
i = i + 1
Loop
end sub
|
最后，把文件名+录制的宏进行配合循环。
Sub copypaste()
Dim dir1 As String
path1 = "C:\Users\Administrator\Desktop\库热力入库单\2022年6月至12月入库单\"
dir1 = Dir(path1)
Dim i As Integer
Dim arr1(1 To 100)
i = 1
Do While dir1 <> ""
arr1(i) = dir1
dir1 = Dir
i = i + 1
Loop
'以上部分为获取文件夹下的文件，并赋值到一个数组当中，方便另存为文件名时使用
'下面部分为录制宏代码基础上的修改。
j = 1
Workbooks.Open Filename:=path1 & arr1(j)
path2 = "C:\Users\Administrator\Desktop\7\"
Do While arr1(j + 1) <> ""
Workbooks.Open Filename:=path1 & arr1(j + 1)
Columns("A:U").Select
Selection.Copy
Windows(arr1(j)).Activate
Sheets("S_KFGL_RKD").Activate
Columns("A:A").Select
ActiveSheet.Paste
Workbooks(arr1(j + 1)).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close
Windows(arr1(j)).Activate
Application.DisplayAlerts = False
Application.DisplayAlerts = True
Sheets("S_KFGL_RKD (2)").Activate
ActiveWorkbook.SaveAs Filename:=path2 & arr1(j + 1)
j = j + 1
Loop
End Sub |
录制的宏，是需要对部分变量进行设置，并增加循环参数。
才能要第1个文件操作完成后，以同样的方式，操作第2个文件，至最后1个文件的结束。
运行以上的vba代码后，我们来看指定文件夹下，生成excel文件的效果：
继续优化后的代码：
对于运行过快，电脑的操作不流畅时，增加vba中一定时间的停顿，比如1秒。
Sub copypaste()
Dim dir1 As String 'path1是原文件目录
path1 = "E:\微信用户名\青青图文广告18799904589\08\阿克苏支队伙食凭证\英阿瓦提3\"
dir1 = Dir(path1)
Dim i As Integer
Dim arr1(1 To 100)
i = 1
Do While dir1 <> ""
arr1(i) = dir1
dir1 = Dir
i = i + 1
Loop
'以上部分为获取文件夹下的文件，并赋值到一个数组当中，方便另存为文件名时使用
'下面部分为录制宏代码基础上的修改。
j = 1 '模板地址打开
Workbooks.Open Filename:="E:\微信用户名\青青图文广告18799904589\08\01.xls"
'下面为另存为文件目录
path2 = "E:\微信用户名\青青图文广告18799904589\08\08\阿克苏支队伙食凭证\英阿瓦提3\"
Do While arr1(j) <> ""
Workbooks.Open Filename:=path1 & arr1(j)
Columns("A:U").Select
Application.Wait (Now + TimeValue("00:00:01"))
Selection.Copy
Application.Wait (Now + TimeValue("00:00:01"))
Windows(2).Activate
Sheets("S_KFGL_RKD").Activate
Application.Wait (Now + TimeValue("00:00:01"))
Columns("A:A").Select
Application.Wait (Now + TimeValue("00:00:01"))
ActiveSheet.Paste
Application.Wait (Now + TimeValue("00:00:01"))
Workbooks(3).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close
Workbooks(2).Activate
Application.DisplayAlerts = False
Application.DisplayAlerts = True
Sheets("S_KFGL_RKD (2)").Activate
ActiveWorkbook.SaveAs Filename:=path2 & arr1(j)
j = j + 1
Loop
ActiveWorkbook.Close
End Sub |
|
|
|
|
